;#
;# PACKAGE:
;# wwwhtml
;#
;# AUTHOR:
;# James Casey
;#
;# DESCRIPTION:
;# A set of routines for dealing with anchors...
;# next_anchor : returns next anchor in a section of HTML
;# parse_anchor : break up an anchor into tags
;# create_anchor : recompose a set of tags into an anchor
;#
;# EXAMPLE:
;#
;# do{
;# local(*Tags);
;#
;# ($Tstart,$Tanchor,$Trest)=&wwwhtml'next_anchor($Trest);
;#
;# &output_html($Tstart);
;#
;# &wwwhtml'parse_anchor($Tanchor,*Tags);
;#
;# ;# ok, got the tags, now process them...
;#
;# $Tanchor=&wwwhtml'create_anchor(*Tags) if $Tanchor ne "";
;# &output_html($Tanchor);
;# } while ($Tanchor ne "");
;# &output_html($Trest);
;#
;#
sub next_anchor{
;#
;# sub: ($start,$anchor,$rest)=&next_anchor($content);
;#
;# Given a section of HTML in $content, will split at next anchor, returning
;# all text before the anchor in $start, the anchor itself in $anchor, and the
;# rest of the file in $rest.
;# If no anchor exixts, returns (start,"","") where $start contains the whole
;# section of HTML.
;#
local($_)=@_;
local($Anchor,$Start,$Rest)=("","","");
if (! /(<\s*a\s+[^>]*>)/i){;# no anchor found
return ($Rest,"","");
}
;# anchor found
$Start=$`;
$Anchor=$&;
$Rest=$';
$Start =~ s/(\W)/\\$1/g;# protect any meta-chars in $Start...
$Anchor=~ s/$Start//ig;# strip off start....
$Anchor=~ s/>[\s\S]*/>/i;# and end.
return ($Start,$Anchor,$Rest);
}
sub parse_anchor{
;#
;# USAGE:
;# $Error=&parse_anchor($anchor,*tags)
;# where $anchor is of form
;# and tag-value pairs are returned in %tags
;#
local($Anchor,*Tags)=@_;
local($Tag,$Id,$Value);
$_=$Anchor;
s/\n//g;# strip out newlines
s/<\s*A(.*)>/\1/i;# strip off
s/\s*=\s*/=/gi;# strip out spaces around '='s
@Tags=split(' ');
foreach $Tag (@Tags){
($Id,$Value)=split ('=',$Tag);
$Value=~ s/"//gi;# strip "'s from $Value
$Id=~ tr/a-z/A-Z/;# convert $Id's to uppercase
$Tags{$Id}=$Value;
}
}
sub create_anchor{
;# USAGE:
;# $anchor=&create_anchor(*tags);
;#
;# This takes an associative array of tags, and creates and anchor from it.
;#
;# It returns an anchor.
local(*Tags)=@_;
local($Id,$Anchor);
$Anchor="