# 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 homepage 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!
$src");
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 = ;
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 block.
# Pass a reference to the hash into parseSegment (us) so that
# the block of repeating html is picked up and associated
# with this hash.
%$aline = ();
%$aline->{'_C__REPEAT__'} = 1;
# $segHash->{$token} = \%$aline;
parseSegment(\%$aline, $aline);
push @segments, $aline;
$aline = || 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 html.
push @segments, $aline;
}
$aline = || 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 this
# 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 value.
my $tmp = $self->{$tok};
push @$tmp, $value;
$self->{$tok} = [ @$tmp ];
}
else
{
$self->{$tok} = $value;
}
}
else
{
bailout("Invalid token '$token'.
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 individual 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
Dump of tokens and values
Dump of tokens and values
| Token | Value |
|---|
EOHTML
dumpit(@_);
print "
";
}
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 "| $key" . " | [$ix] | @$tmp[$ix] |
\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 "
| $seg |
\n";
dumpit(\%$seg);
print "| |
\n";
}
else
{
print "| $seg | " . $self->{$seg} . " |
\n";
}
}
}
}
}
sub bailout()
{
my $mess = splice @_;
$retVal =<
Template Error!
$mess
HTML10
print $retVal;
croak "Template Error : $mess";
}
sub DESTROY()
{
}
1;