Here is the code in the .pm file....
# Bilstone html template parser # # April 1999 # Version 0.91 beta # 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 # package HTMLTMPL; use Carp; sub new() { my %baseHtml = (); bless \%baseHtml; 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. # Parse the html into an array. open(HTML, $src) || bailout("Cannot open html template file!<br>$s +rc"); parseSegment($self, '_e_o_f_'); close HTML; } # Reads html from handle. # Adds segments to array within the given hash parameter. # sub parseSegment() { my ($segHash, $endOfSeg) = @_; my @segments = (); my $repeating = $segHash->{'_C__REPEAT__'}; $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. %$aline = (); %$aline->{'_C__REPEAT__'} = 1; # $segHash->{$token} = \%$aline; parseSegment(\%$aline, $aline); 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 =~ /^(.*?)(__.+?__)/) { $padding = $1; $token = $2; # 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; $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/.*:://; $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; $self->{$tok} = [ @$tmp ]; } else { $self->{$tok} = $value; } } else { bailout("Invalid token '$token'.<br>Maybe it needs qualifying +within a " . "block?"); } } sub output() { my $self = shift; foreach $hdr (@_) { print "$hdr\n"; } print "\n"; mergeData($self); } sub mergeData() { my ($leg) = @_; my $segs = $leg->{'_C__HTML__'}; my $repeating = $leg->{'_C__REPEAT__'}; my $entries = 1; if ($repeating) { # determine number of times we need to repeat putting out this # segment. foreach $key (keys %$leg) { next if ($key =~ /^_C__/); # ignore control entries. my $tmp = $leg->{$key}; $entries = $#$tmp; $entries++; last; } } for ($ix=0; $ix < $entries; $ix++) { # Walk the array of html segments. 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. mergeData(\%$seg); } else { if ($repeating) { # Output next value from array for this token. my $temp = $leg->{$seg}; print @$temp[$ix]; } else { # Output token value. print $leg->{$seg}; } } } else { # Stright html print $seg; } } } } 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) { # Determine number of entries in block values. foreach $key (keys %$self) { next if ($key =~ /^_C__/); # ignore control entries. my $tmp = $self->{$key}; $entries = $#$tmp; $entries++; last; } for ($ix=0; $ix < $entries; $ix++) { 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__'}; 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>&nbsp;</td>< +/tr>\n"; } else { print "<tr><td>$seg</td><td colspan=2>" . $self->{ +$seg} . "</td></tr>\n"; } } } } } sub bailout() { my $mess = splice @_; $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 Re^5: HTML Template by raptorsoul
in thread HTML Template by raptorsoul

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.