# 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 homepage 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!
$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 = ;
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.
#
my $tokId = $aline;
$tokId =~ s/__x_(.+)__/$1/;
%$aline = ();
%$aline->{'_C__ID__'} = $tokId;
%$aline->{'_C__REPEaT__'} = 1;
parseSegment(\%$aline, $aline, $allToks);
push @segments, $aline;
$aline = || 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 : $tokId);
$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/.*:://;
my $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;
}
else
{
$self->{$tok} = $value;
}
}
else
{
bailout("Invalid token '$token'.
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 output.
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 individual 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 prefixed
# with 'block_name:'.
#
sub listallTokens()
{
my $self = shift;
return $self->{'_C__TOKLIST__'};
}
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)
{
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 "| $key" . " | [$ix] | @$tmp[$ix] |
\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 "
| $seg |
\n";
dumpit(\%$seg);
print "| |
\n";
}
else
{
print "| $seg | " . $self->{$seg} . " |
\n";
}
}
}
}
}
sub bailout()
{
my $mess = splice @_;
my($retVal) =<
Template Error!
$mess
HTML10
print $retVal;
croak "Template Error : $mess";
}
sub DESTROY()
{
}
1;