# $Id: Chunks.pm,v 1.3 2005/06/28 07:06:17 mark Exp $
package HTML::Chunks;
use strict;
our $VERSION = '1.53';
our $DATA_REGEX = qr/##[\w\.]+##/;
sub new
{
my $self = bless {}, shift;
$self->init(@_);
return $self;
}
sub init
{
my $self = shift;
$self->{crush} = 1;
$self->{cascade} = 1;
$self->{dataStack} = [];
$self->{chunk} = {};
$self->{default} = undef;
$self->read(@_) if @_;
}
sub readChunkFile
{
my $self = shift;
foreach my $file (@_) {
if (my $fh = $self->getFilehandle($file)) {
my @chunkStack;
while (my $line = <$fh>) {
$self->parse(\@chunkStack, \$line);
}
close $fh;
}
else {
warn "Can't open file [$file]\n";
}
}
}
sub readSimpleFile
{
my $self = shift;
foreach my $file (@_) {
if (my $fh = $self->getFilehandle($file)) {
while (<$fh>) {
next if /^#/ or !/\S/;
s/[\r\n]//g;
s/^\s+|\s+$//g;
my ($name, $chunk) = split(/\s+/, $_, 2);
if ($name && $chunk) {
$self->addNamedChunk($name, $chunk);
}
}
close $fh;
}
}
}
sub getFilehandle
{
my $self = shift;
my ($file) = @_;
return $file if ref $file; # already a filehandle
return open (CHUNKIN, $file) ? \*CHUNKIN : undef;
}
sub addChunk
{
my $self = shift;
foreach my $chunk (@_) {
next unless $chunk;
# allow a ref to be passed for efficiency
my $ref = ref $chunk ? $chunk : \$chunk;
$self->parse([], $ref);
}
}
sub addNamedChunk
{
my $self = shift;
my ($name, $chunk) = @_;
return unless ($name && $chunk);
# allow a ref to be passed for efficiency
my $ref = ref $chunk ? $chunk : \$chunk;
$self->{chunk}{$name} = undef;
$self->parse([ \$self->{chunk}{$name} ], $ref);
}
sub parse
{
my $self = shift;
my ($chunkStack, $data) = @_;
my $chunk = $chunkStack->[-1];
# allow a ref to be passed for efficiency
my $dataRef = ref $data ? $data : \$data;
foreach (split(/()/, $$dataRef)) {
if (//i) {
$self->{chunk}{$1} = undef;
push @{$chunkStack}, $chunk = \$self->{chunk}{$1};
}
elsif ($chunk && //i) {
$$chunk =~ s/\s{2,}/\n/sg if $self->{crush}; # crush whitespace
pop @{$chunkStack};
$chunk = $chunkStack->[-1];
}
elsif ($chunk && ($_ || !$self->{crush})) {
$$chunk .= $_;
}
}
}
sub output
{
my $self = shift;
my $name = shift;
$self->outputAsChunk(\$self->{chunk}{$name}, @_);
}
sub outputAsChunk
{
my $self = shift;
my $chunk = shift;
my $data = shift;
if ($chunk) {
my $chunkRef = ref $chunk ? $chunk : \$chunk;
$data ||= {};
push @{$self->{dataStack}}, $data;
$self->outputBasicChunk($chunkRef, @_);
pop @{$self->{dataStack}};
}
}
# basic chunk output including data substitution, using data already
# on the data stack.
sub outputBasicChunk
{
my $self = shift;
my $chunk = shift;
my $chunkRef = ref $chunk ? $chunk : \$chunk;
foreach my $piece (split(/(|$DATA_REGEX)/o, $$chunkRef)) {
if ($piece =~ /($DATA_REGEX)/o) {
$self->outputData(substr($1, 2, -2), @_);
}
else {
print $piece;
}
}
}
sub outputData
{
my $self = shift;
my $name = shift;
my $value = $self->getDataValue($name);
if (ref $value eq 'CODE') {
&{$value}($self, $name, @_);
}
else {
print $value;
}
}
sub getDataValue
{
my ($self, $name) = (shift, shift);
my $value;
my $last = $self->{cascade} ? 0 : $#{$self->{dataStack}};
for (my $ndx = $#{$self->{dataStack}}; $ndx >= $last; $ndx--) {
if (exists($self->{dataStack}[$ndx]{$name})) {
$value = $self->{dataStack}[$ndx]{$name};
last;
}
}
if ($value eq '') {
return $self->{default};
}
else {
return $value;
}
}
sub getChunkNames
{
my $self = shift;
return keys %{$self->{chunk}};
}
sub getChunk
{
my $self = shift;
my ($name) = @_;
return $self->{chunk}{$name};
}
sub getChunkHash
{
my $self = shift;
return { %{$self->{chunk}} };
}
sub setCrush
{
my $self = shift;
my $old = $self->{crush};
($self->{crush}) = (@_);
return $old;
}
sub setCascade
{
my $self = shift;
my $old = $self->{cascade};
($self->{cascade}) = (@_);
return $old;
}
sub setDefaultDataValue
{
my $self = shift;
($self->{default}) = (@_);
}
# legacy wrappers for backward compatibility
sub crush
{
my $self = shift;
return $self->setCrush(@_);
}
sub read
{
my $self = shift;
$self->readChunkFile(@_);
}
1;
__END__
=pod
=head1 NAME
HTML::Chunks - A simple nested template engine for HTML, XML and XHTML
=head1 VERSION
1.53
=head1 DESCRIPTION
This class implements a simple text-based template engine, originally
intented to allow web applications to completely separate layout HTML from
programming logic. However, the engine is flexible enough to be applied
to other text-based situations where templates are helpful, such as
generating email messages, XML data files, etc.
=head1 SYNOPSIS
my $engine = new HTML::Chunks(@chunkFiles);
$engine->readChunkFile('morechunks.html');
$engine->addChunk($smallChunk, \$hugeChunk);
$engine->addNamedChunk('myChunk', $chunk);
$engine->output('myChunk', {
firstName => 'Homer',
lastName => 'Simpson',
meals => \&outputMeals
}, @extraData);
my @names = $engine->getChunkNames();
my $chunk = $engine->getChunk('myChunk');
my $oldValue = $engine->setCrush(0);
=head1 CHUNK SYNTAX
This template engine is based upon "chunks", which are merely named
chunks of textual information such as HTML. Each chunk may be individually
addressed by an application to produce output. A chunk definition may also
contain data elements which will be replaced with dynamic data at
runtime. A simple chunk definition looks like:
| ##date## |
##food## |
This defines a chunk named I. This chunk contains two data elements
named I and I. These will both be replaced with real data by
the application at runtime. The leading and trailing ## characters simply
identify them as data elements and are not part of the actual names.
Chunk definitions can even be embedded within one another. It's possible
(and recommended!) to construct a definition file as a full HTML file that
you can preview in a web browser. Embedding one chunk definition within
another does not imply any association or positional placement between the
two chunks. Things would turn out the same if you put the definitions in
a straight list, one after another. Embedding is just a cool formatting
convenience that you can choose to take advantage of -- or not.
You may optionally surround a data element with HTML comment characters
so it won't show up when previewing a chunk file in a browser. For this
to work, the data element must be the only thing in the comment, such as:
The entire comment will be replaced with the data value at run time, so
the resulting data will I be within a comment.
See the I section below for a sample.
=head1 ROUTINES
=over
=item my $engine = new HTML::Chunks(@files);
Constructs a new chunk engine object and reads any supplied chunk files.
=item $engine->readChunkFile(@files);
Reads the specified chunk definition files.
=item $engine->readSimpleFile(@files);
Reads chunk definitions from an alternate simpler file format. This
should only be used for defining very short chunks with minimal HTML.
It comes in very handy for small configuration elements. The format
allows one definition per line, with each line containing the chunk name
followed by any amount of whitespace followed by the chunk definition.
For example:
imageURL http://images.myserver.com/
errorMsg Awooga! Something has gone haywire!
=item $engine->addChunk(@chunks);
Defines new chunks according to the definitions contained in the supplied
list. Each member of the list must hold at least one full chunk
definition, complete with BEGIN/END statements. The list may contain
simple string scalars or references to scalars. References are handy
if you have a large chunk loaded and wish to conserve memory.
=item $engine->addNamedChunk($name, $chunk);
Defines a new chunk named I<$name>. The chunk definition contained in
I<$chunk> does not need the outer set of BEGIN/END statements since the
name is already specified. This comes in handy when you are reading
chunk definitions from a database column and don't want to bother with
redundant embedded BEGIN/END statements for each row. I<$chunk>
may be either a scalar or reference to a scalar. References are handy
if you have a large chunk loaded and wish to conserve memory.
=item my @names = $engine->getChunkNames();
Returns a list of defined chunk names.
=item my $chunk = $engine->getChunk($name);
Returns the body of a defined chunk named I<$name>. You I
need to do this, and we strongly discourage bypassing the I