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> </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;
|