# Bilstone html template parser # # May 2000 # Version 1.21 production # author Ian Steel (ian@bilstone.co.uk) # # For latest releases, documentation, faqs, etc see the homepag +e at # http://freeweb.ftech.net/bilstone/htmltmpl.html # # History: # # april 1999 - First cut # September 1999 - added strict. # May 2000 - Speed Improvement. # package HTMLTMPL; use strict; use vars qw($aUTOLOaD); use Carp; no strict 'refs'; sub new() { my $class = shift; my %baseHtml = (); bless \%baseHtml, $class; return \%baseHtml } sub src() { if ($#_ != 1) { bailout("Error! template function requires a single parameter\ +n"); } my $self = shift; my $src = shift; $self->{'_C__REPEaT__'} = 0; # Not a repeating block as this is + the # main html page. my $allToks = []; # Parse the html into an array. # open(HTML, "<$src") || bailout("Cannot open html template file!<br +>$src"); parseSegment($self, '_e_o_f_', $allToks); $self->{'_C__TOKLIST__'} = $allToks; # array of all tokens. close HTML; } # Reads html from handle. # adds segments to array within the given hash parameter. # sub parseSegment() { my ($segHash, $endOfSeg, $allToks) = @_; my @segments = (); my $repeating = $segHash->{'_C__REPEaT__'}; my $aline = <HTML>; while (!($aline =~ /$endOfSeg/)) { if ($aline =~ /__.+__/) { if ($aline =~ /^__x_.+__/) { chomp $aline; # The start of a repeating block # Create a hash which is named after the repeating blo +ck. # Pass a reference to the hash into parseSegment (us) +so that # the block of repeating html is picked up and asso +ciated # with this hash. # my $tokId = $aline; $tokId =~ s/__x_(.+)__/$1/; %$aline = (); %$aline->{'_C__ID__'} = $tokId; %$aline->{'_C__REPEaT__'} = 1; parseSegment(\%$aline, $aline, $allToks); push @segments, $aline; $aline = <HTML> || last; next; } # This line contains a token. # Break up line to get out tokens, and store in array. # while ($aline =~ /^(.*?)(__.+?__)/) { my $padding = $1; my $token = $2; my $tokId = $2; $tokId =~ s/__(.+)__/$1/; # For a repeating block, each token will have to hold +an array # of values. For non-repeating, just a scalar. # $segHash->{$token} = ($repeating ? [] : ''); push @segments, $padding; push @segments, $token; push @$allToks, ($repeating ? $segHash->{'_C__ID__'} . ":" . $tokId : $t +okId); $aline =~ s/^.*?__.+?__//o; } # Don't forget remainder of line # push @segments, $aline; } else { # No token in this line of html, so just add to array of h +tml. # push @segments, $aline; } $aline = <HTML> || last; } if (($aline ne "$endOfSeg\n") && ($endOfSeg ne '_e_o_f_')) { bailout("Mismatch of end of block token ('$endOfSeg')!"); } $segHash->{'_C__HTML__'} = [ @segments ]; } sub aUTOLOaD { my $token = $aUTOLOaD; my ($self, $value, $block) = @_; if (defined $block) { # Self needs to refer to the repeating block now rather than t +his # object because the user wants to store a repeating block +value. # my $tmp = '__' . $block . '__'; $self = \%$tmp; } $token =~ s/.*:://; my $tok = '__' . $token . '__'; if (exists $self->{$tok}) { if (defined $block) { # within a block so add to array rather than storing raw v +alue. # my $tmp = $self->{$tok}; push @$tmp, $value; } else { $self->{$tok} = $value; } } else { bailout("Invalid token '$token'.<br>Maybe it needs qualifying +within a " . "block?"); } } sub output() { my $self = shift; my $hdr; foreach $hdr (@_) { print "$hdr\n"; } print "\n"; print mergeData($self); } sub htmlString() { my $self = shift; return mergeData($self); } sub mergeData() { my ($leg) = @_; my $segs = $leg->{'_C__HTML__'}; my $repeating = $leg->{'_C__REPEaT__'}; my $entries = 1; my $htmlGen; # Generated html to be out +put. if ($repeating) { # determine number of times we need to repeat putting out this # segment. # my $key; foreach $key (keys %$leg) { next if ($key =~ /^_C__/); # ignore control entries. my $tmp = $leg->{$key}; $entries = $#$tmp; $entries++; last; } } my $ix; for ($ix=0; $ix < $entries; $ix++) { # Walk the array of html segments. # my $seg; foreach $seg (@$segs) { if ($seg =~ /__.*__/) # Is it a token? { if ($seg =~ /^__x_.+__/) # Repeating? { chomp($seg); # This is a repeating block rather than an individ +ual token, # so process it seperately. # $htmlGen .= mergeData(\%$seg); } else { if ($repeating) { # Output next value from array for this token. # my $temp = $leg->{$seg}; # print @$temp[$ix]; $htmlGen .= @$temp[$ix]; } else { # Output token value. # # print $leg->{$seg}; $htmlGen .= $leg->{$seg}; } } } else { # Straight html # # print $seg; $htmlGen .= $seg; } } } return $htmlGen; } # Returns a ref to an array. Each element of the array contains the + name of a # token within the template. Tokens within repeating blocks are pre +fixed # with 'block_name:'. # sub listallTokens() { my $self = shift; return $self->{'_C__TOKLIST__'}; } sub dumpall() { print << "EOHTML"; Content-type: text/html <html><head><title>Dump of tokens and values</title></head> <body bgcolor=beige> <h3 align=center>Dump of tokens and values</h3> <p> <table border=1 align=center> <tr align=center><th bgcolor=lightblue>Token</th><th colspan=2 bgcolor +=lightblue>Value</th></tr> EOHTML dumpit(@_); print "</table></body></html>"; } sub dumpit() { my ($self, $block) = @_; if (defined $block) { $self = \%$block if (defined $block); } my $repeating = $self->{'_C__REPEaT__'}; if ($repeating) { my($entries); # Determine number of entries in block values. # my($key); foreach $key (keys %$self) { next if ($key =~ /^_C__/); # ignore control entries. my $tmp = $self->{$key}; $entries = $#$tmp; $entries++; last; } my($ix); for ($ix=0; $ix < $entries; $ix++) { my($key); foreach $key (keys %$self) { next if ($key =~ /^_C__/); # ignore control entries +. my $tmp = $self->{$key}; print "<tr><td>$key" . "</td><td>[$ix]</td><td>@$tmp[$ +ix]</td><tr>\n"; } } } else { # Walk the array of html segments. # my $segs = $self->{'_C__HTML__'}; my($seg); foreach $seg (@$segs) { if ($seg =~ /^__.+__$/) { # dump only the tokens # if ($seg =~ /^__x_.+__$/) { # repeating block so treat as seperate section # chomp $seg; print "<tr><td colspan=3 align=center>$seg</td></t +r>\n"; dumpit(\%$seg); print "<tr><td colspan=3 align=center> </td>< +/tr>\n"; } else { print "<tr><td>$seg</td><td colspan=2>" . $self->{ +$seg} . "</td></tr>\n"; } } } } } sub bailout() { my $mess = splice @_; my($retVal) =<<HTML10; content-type: text/html <html><head></head> <body bgcolor=red> <p> <font color=white> <h3>Template Error!</h3> <center> $mess </center> </p> <hr> </body></html> HTML10 print $retVal; croak "Template Error : $mess"; } sub DESTROY() { } 1;
In reply to A template module question by Stamp_Guy
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |