perl/Text/CPPTemplate.pm

# Text::CPPTemplate 0.3
# copyright (c) 2000, ETH Zurich
# released under the GNU General Public License

package Text::CPPTemplate;

use strict;

use vars qw($VERSION);
$VERSION = 0.3;

=head1 NAME

Text::CPPTemplate - CPP-Style Templates

=head1 SYNOPSIS

 use Text::CPPTemplate;

 my $templ = new Text::CPPTemplate('/var/web/templates','.html');

 print $templ->template({
        PAGE => 'index',
        ELEMENT => 'header',
        TITLE => 'Test'
 });

=head1 DESCRIPTION

CPPTemplate is a templating system using a CPP-style (C Pre-Processor) syntax.
CPPTemplate is quite fast so that it can be used in online Applications such
as CGI scripts to separate program the code from the HTML. CPPTemplate is not
HTML specific, so it can be used for other applications. For performance
reasons, the files containing the templates are read only once and are cached
for further use. This is especially handy when working with long running
scripts which use the same template over and over again. Apache mod_perl is
such an environment.

An application can use a large number of templates. They could for example represent
different parts of output generated by the aplication.
Each template can contain variables and CPP style if-then-else structures. 
When the template gets activated, all the variables will get substituted
and the if-then-else structures will get processed.

=head1 FILE NAMES

When you activate a template, you do not specify a file-name, but only
variables. Based on the contents of some special variables, CPPTemplate will try
to load an apropriate template file from disk. It tries to do this using a number of
different file-names. The first one to exist will be used.
A directory where the templates reside and a suffix have to be specified
with the C<new> method. The following list shows which variables cause CPPTemplate to
look for which files:

=over 4

=item *

I<PAGE>B<_>I<ELEMENT> (I<PAGE> and I<ELEMENT> are variables)

=item *

I<ELEMENT>

=item *

I<PAGE>

=item *

C<default> (as is, not a variable)

=back

In addition, if I<THEME> is specified, the template will be first searched in
the subdirectory specified by that variable of the templates directory.

In the example given in L<SYNOPSIS>, the following files will be
opened in turn until one is found to exist (in the directory F</var/web/templates>):
F<index_header.html>, F<header.html>, F<index.html> and F<default.html>.

=head1 VARIABLE SUBSTITUTION

Variables are marked C<##var##> in the templates. If no variable is found with
that specified name, the ##var## text remains unchanged.

=head1 CPP-STYLE DIRECTIVES

"MiniCPP" directives permit the selection of parts of the template based on
some condition. The language is very very basic, it seems to be good-enough
for most applications. The following directives are supported:

=over 4

=item C<// comment>

The whole line is removed from the output

=item C<#ifdef VAR>

If variable VAR is defined, the following text will be selected.

=item C<#if expr>

If the expression C<expr> evaluates to true (see L<"EXPRESSIONS">), the
following text will be selected. You can use substitutions in the expression
with the syntax '##VAR##'.

=item C<#elif expr>

If the previous C<#if> (or C<#elif>) expression was false, evaluate this
C<expr> and if true select the following text.

=item C<#else>

If the previous C<#if> (or C<#elif>) expression was false, select the following text.

=item C<#endif>

Ends an C<#ifdef> or an C<#if>.

=back

Note that these elements can be nested.

The newlines will be removed unless two consecutive lines without MiniCPP
directives are found. Spaces and tabs will be removed from the beginning and
the end of each line. Use '\ ' (backslash space) to insert spaces at the
beginning or the end of the line.


=head1 EXPRESSIONS

At the moment only the following expressions are supported (don't laugh :-))

=over 4

=item A = B

If A is equal to B (the text), then the expression is true.

=item A ~ B

Match A against the regular expression (perl) B. True if it does match, false
otherwise.

=back

=head1 EXAMPLE

 #if ##ELEMENT## = ruler
 <HR>
 #elif ##ELEMENT## = buttons
   #ifdef ADD_URL
     <A href="##ADD_URL##">Add</A>
   #endif
   #ifdef PREV_URL
     <A href="##PREV_URL##">Prev</A>
   #endif
   #ifdef NEXT_URL
     <A href="##NEXT_URL##">Next</A>
   #endif
   </P>
 #endif


=head1 PER-METHOD DOCUMENTATION

=over 4

=cut

######## MINI CPP #########

sub _process_if
{
        my $state= shift;
        my $expr = shift;

        my $last_state = $state->[$#$state];
        if($expr) {
                push @$state, $last_state;
        }
        else {
                push @$state, 0;
        }
}

sub _substitute
{
        $_ = shift;
        my $vars = shift;
        my $val;
        s/##(\w+)##/$val=$vars->{$1};defined $val?$val:"##$1##"/ge;
        return $_;
}

sub _eval_expr
{
        my $expr = shift;
        my $vars = shift;

        $expr =~ s/^\s+//; $expr =~ s/\s+$//;
        if($expr =~ /^(.+?)\s*=\s*(.*)$/) {
                my $a = _substitute($1, $vars);
                my $b = _substitute($2, $vars);
                #print "<BR>@@@ $a eq $b ?\n";
                return $a eq $b;
        }
        elsif($expr =~ /^(.+?)\s*~\s*(.*)$/) {
                my $a = _substitute($1, $vars);
                my $b = _substitute($2, $vars);
                #print "<BR>@@@ $a ~ $b ?\n";
                return ($a =~ /$b/);
        }
        else {
                return $expr;
        }
}

sub _mini_cpp
{
        my $self = shift;
        my $in = shift;
        my $vars = shift;
        my $out = '';

        my @state = (1);
        my $line;
        my $next_linefeed=0;
        foreach $line (@$in) {
#print "@@@@@@ |".join('',@state)."| $line\n";
                if($line !~ /^#[a-z]/) {        # data
                        if($state[$#state]==1) {
                                $out .= "\n" if $next_linefeed;
                                $out .= _substitute($line,$vars);
                                $next_linefeed=1;
                        }
                        next;
                }
                $next_linefeed=0;
                if($line =~ /^#endif/) {           # #endif
                        if($#state<=0) {
                                $out .= "\n!!! SYNTAX ERROR: UNEXPECTED #endif !!!\n";
                        }
                        else {
                                $#state--; # fast pop :-)
                        }
                        next;
                }
                if($line =~ /^#else/) {            # #else
                        if($#state<=0) {
                                $out .= "\n!!! SYNTAX ERROR: UNEXPECTED #else !!!\n";
                        }
                        else {
                                next unless $state[$#state-1];
                                push @state, pop @state ? 0 : 1;
                        }
                        next;
                }
                if($line =~ /^#elif\s+(.+)$/) { # #elif
                        if($#state<=0) {
                                $out .= "\n!!! SYNTAX ERROR: UNEXPECTED #elif !!!\n";
                        }
                        else {
                                next unless $state[$#state-1];
                                if($state[$#state]) {
                                        $state[$#state] = 2;
                                }
                                else {
                                        $#state--;
                                        _process_if(\@state, _eval_expr($1,$vars));
                                }
                        }
                        next;
                }
                if($line =~ /^#if\s+(.+?)$/) {  # #if
                        _process_if(\@state, $state[$#state] ?  _eval_expr($1,$vars) : 0);
                        next;
                }
                if($line =~ /^#ifdef\s+(\w+)/) {   # #ifdef
                        my $def = $vars->{$1};
                        _process_if(\@state, ((defined $def) and ($def ne '')));
                        next;
                }

                $out .= "\n!!! SYNTAX ERROR: UNRECOGNIZED TOKEN !!!\n";
        }

        return $out;
}

####### TEMPLATE #######

sub _slurp_file
{
        my $self = shift;
        my $file = shift;

        #print "<BR>reading $file...<BR>\n";

        my $RS_bak = $/;
        undef $/;
        open(SLURP, "<$file") or do {
                return "\n!!! ERROR: couldn't find $file !!!\n";
        };
        my $data = <SLURP> || '';
        close(SLURP);
        $/=$RS_bak;

        # replace '\ ' to a special unprobable string
        $data =~ s/\\ /<<SpAcE>>/g;

        # trim
        $data =~ s/^[ \t]+//gm;
        $data =~ s/[ \t]+$//gm;

        # replace the forced-space string to a space
        $data =~ s/<<SpAcE>>/ /g;

        # strip comments
        $data =~ s|^//.*||gm;

        my @ldata = split("\n",$data,-1);
        return \@ldata;
}

sub _get_template
{
        my $self = shift;
        my $name = shift;

        my $tdir = $self->{dir};
        my $suff = $self->{suff};

        if(!exists $self->{cache}{$name}) {
                my @names = split /\|/, $name;
                my $ok = 0;
                my $filename;
                foreach (@names) {
                        $filename = "$tdir/$_$suff";
                        if(-r $filename) {
                                $self->{cache}{$name} = $self->_slurp_file($filename);
                                $ok = 1;
                                last;
                        }
                }
                if(!$ok) {
                        return ["!!! ERROR: couldn't find a template for $name (t-dir: $tdir) !!!"];
                }
        }

        return $self->{cache}{$name};
}

=item C<new($templates_dir, $suffix)>

Create a new CPPTemplate object. C<$templates_dir> is the directory where the templates
are stored and C<$suffix> is a text to append to the file-names.

=cut

sub new {
        my $proto = shift;
        my $tdir = shift;
        my $suff = shift;

        my $class = ref($proto) || $proto;
        my $self  = {};

        $self->{cache} = {};
        $self->{dir}=$tdir;
        $self->{suff}=$suff;

        bless($self,$class);
        return $self;
}

=item C<template(\%vars)>

Return a processed template. C<\%vars> is a hashref containing the variables used for building
the file-name, for the substitutions and the CPP-style directives.

=cut

sub template($)
{
        my $self = shift;
        my $vars = shift;

        my $name = $vars->{PAGE}.'_'.$vars->{ELEMENT}.'|'.
                $vars->{ELEMENT}.'|'.
                $vars->{PAGE}.'|default';

        # themes:
        if(defined $vars->{THEME}) {
                $name = $vars->{THEME}.'/'.$vars->{PAGE}.'_'.$vars->{ELEMENT}.'|'.
                        $vars->{THEME}.'/'.$vars->{ELEMENT}.'|'.
                        $vars->{THEME}.'/'.$vars->{PAGE}.'|'.
                        $vars->{THEME}.'/default'.'|'.
                        $name;
        }
        my $templ = $self->_get_template($name);
        my $out   = $self->_mini_cpp($templ, $vars);
        chomp $out;
        return $out;
}

1;

=back

=head1 SEE ALSO

Text::TagTemplate(3)

=head1 COPYRIGHT

Copyright (c) 2000 ETH Zurich, All rights reserved.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

=head1 AUTHOR

David Schweikert <dws@ee.ethz.ch>,
Tobi Oetiker <oetiker@ee.ethz.ch>
1	dpavlin	1	# Text::CPPTemplate 0.3
2			# copyright (c) 2000, ETH Zurich
3			# released under the GNU General Public License
4
5			package Text::CPPTemplate;
6
7			use strict;
8
9			use vars qw($VERSION);
10			$VERSION = 0.3;
11
12			=head1 NAME
13
14			Text::CPPTemplate - CPP-Style Templates
15
16			=head1 SYNOPSIS
17
18			use Text::CPPTemplate;
19
20			my $templ = new Text::CPPTemplate('/var/web/templates','.html');
21
22			print $templ->template({
23			PAGE => 'index',
24			ELEMENT => 'header',
25			TITLE => 'Test'
26			});
27
28			=head1 DESCRIPTION
29
30			CPPTemplate is a templating system using a CPP-style (C Pre-Processor) syntax.
31			CPPTemplate is quite fast so that it can be used in online Applications such
32			as CGI scripts to separate program the code from the HTML. CPPTemplate is not
33			HTML specific, so it can be used for other applications. For performance
34			reasons, the files containing the templates are read only once and are cached
35			for further use. This is especially handy when working with long running
36			scripts which use the same template over and over again. Apache mod_perl is
37			such an environment.
38
39			An application can use a large number of templates. They could for example represent
40			different parts of output generated by the aplication.
41			Each template can contain variables and CPP style if-then-else structures.
42			When the template gets activated, all the variables will get substituted
43			and the if-then-else structures will get processed.
44
45			=head1 FILE NAMES
46
47			When you activate a template, you do not specify a file-name, but only
48			variables. Based on the contents of some special variables, CPPTemplate will try
49			to load an apropriate template file from disk. It tries to do this using a number of
50			different file-names. The first one to exist will be used.
51			A directory where the templates reside and a suffix have to be specified
52			with the C<new> method. The following list shows which variables cause CPPTemplate to
53			look for which files:
54
55			=over 4
56
57			=item *
58
59			I<PAGE>B<_>I<ELEMENT> (I<PAGE> and I<ELEMENT> are variables)
60
61			=item *
62
63			I<ELEMENT>
64
65			=item *
66
67			I<PAGE>
68
69			=item *
70
71			C<default> (as is, not a variable)
72
73			=back
74
75			In addition, if I<THEME> is specified, the template will be first searched in
76			the subdirectory specified by that variable of the templates directory.
77
78			In the example given in L<SYNOPSIS>, the following files will be
79			opened in turn until one is found to exist (in the directory F</var/web/templates>):
80			F<index_header.html>, F<header.html>, F<index.html> and F<default.html>.
81
82			=head1 VARIABLE SUBSTITUTION
83
84			Variables are marked C<##var##> in the templates. If no variable is found with
85			that specified name, the ##var## text remains unchanged.
86
87			=head1 CPP-STYLE DIRECTIVES
88
89			"MiniCPP" directives permit the selection of parts of the template based on
90			some condition. The language is very very basic, it seems to be good-enough
91			for most applications. The following directives are supported:
92
93			=over 4
94
95			=item C<// comment>
96
97			The whole line is removed from the output
98
99			=item C<#ifdef VAR>
100
101			If variable VAR is defined, the following text will be selected.
102
103			=item C<#if expr>
104
105			If the expression C<expr> evaluates to true (see L<"EXPRESSIONS">), the
106			following text will be selected. You can use substitutions in the expression
107			with the syntax '##VAR##'.
108
109			=item C<#elif expr>
110
111			If the previous C<#if> (or C<#elif>) expression was false, evaluate this
112			C<expr> and if true select the following text.
113
114			=item C<#else>
115
116			If the previous C<#if> (or C<#elif>) expression was false, select the following text.
117
118			=item C<#endif>
119
120			Ends an C<#ifdef> or an C<#if>.
121
122			=back
123
124			Note that these elements can be nested.
125
126			The newlines will be removed unless two consecutive lines without MiniCPP
127			directives are found. Spaces and tabs will be removed from the beginning and
128			the end of each line. Use '\ ' (backslash space) to insert spaces at the
129			beginning or the end of the line.
130
131
132			=head1 EXPRESSIONS
133
134			At the moment only the following expressions are supported (don't laugh :-))
135
136			=over 4
137
138			=item A = B
139
140			If A is equal to B (the text), then the expression is true.
141
142			=item A ~ B
143
144			Match A against the regular expression (perl) B. True if it does match, false
145			otherwise.
146
147			=back
148
149			=head1 EXAMPLE
150
151			#if ##ELEMENT## = ruler
152			<HR>
153			#elif ##ELEMENT## = buttons
154			#ifdef ADD_URL
155			<A href="##ADD_URL##">Add</A>
156			#endif
157			#ifdef PREV_URL
158			<A href="##PREV_URL##">Prev</A>
159			#endif
160			#ifdef NEXT_URL
161			<A href="##NEXT_URL##">Next</A>
162			#endif
163			</P>
164			#endif
165
166
167			=head1 PER-METHOD DOCUMENTATION
168
169			=over 4
170
171			=cut
172
173			######## MINI CPP #########
174
175			sub _process_if
176			{
177			my $state= shift;
178			my $expr = shift;
179
180			my $last_state = $state->[$#$state];
181			if($expr) {
182			push @$state, $last_state;
183			}
184			else {
185			push @$state, 0;
186			}
187			}
188
189			sub _substitute
190			{
191			$_ = shift;
192			my $vars = shift;
193			my $val;
194			s/##(\w+)##/$val=$vars->{$1};defined $val?$val:"##$1##"/ge;
195			return $_;
196			}
197
198			sub _eval_expr
199			{
200			my $expr = shift;
201			my $vars = shift;
202
203			$expr =~ s/^\s+//; $expr =~ s/\s+$//;
204			if($expr =~ /^(.+?)\s=\s(.*)$/) {
205			my $a = _substitute($1, $vars);
206			my $b = _substitute($2, $vars);
207			#print "<BR>@@@ $a eq $b ?\n";
208			return $a eq $b;
209			}
210			elsif($expr =~ /^(.+?)\s~\s(.*)$/) {
211			my $a = _substitute($1, $vars);
212			my $b = _substitute($2, $vars);
213			#print "<BR>@@@ $a ~ $b ?\n";
214			return ($a =~ /$b/);
215			}
216			else {
217			return $expr;
218			}
219			}
220
221			sub _mini_cpp
222			{
223			my $self = shift;
224			my $in = shift;
225			my $vars = shift;
226			my $out = '';
227
228			my @state = (1);
229			my $line;
230			my $next_linefeed=0;
231			foreach $line (@$in) {
232			#print "@@@@@@ \|".join('',@state)."\| $line\n";
233			if($line !~ /^#[a-z]/) { # data
234			if($state[$#state]==1) {
235			$out .= "\n" if $next_linefeed;
236			$out .= _substitute($line,$vars);
237			$next_linefeed=1;
238			}
239			next;
240			}
241			$next_linefeed=0;
242			if($line =~ /^#endif/) { # #endif
243			if($#state<=0) {
244			$out .= "\n!!! SYNTAX ERROR: UNEXPECTED #endif !!!\n";
245			}
246			else {
247			$#state--; # fast pop :-)
248			}
249			next;
250			}
251			if($line =~ /^#else/) { # #else
252			if($#state<=0) {
253			$out .= "\n!!! SYNTAX ERROR: UNEXPECTED #else !!!\n";
254			}
255			else {
256			next unless $state[$#state-1];
257			push @state, pop @state ? 0 : 1;
258			}
259			next;
260			}
261			if($line =~ /^#elif\s+(.+)$/) { # #elif
262			if($#state<=0) {
263			$out .= "\n!!! SYNTAX ERROR: UNEXPECTED #elif !!!\n";
264			}
265			else {
266			next unless $state[$#state-1];
267			if($state[$#state]) {
268			$state[$#state] = 2;
269			}
270			else {
271			$#state--;
272			_process_if(\@state, _eval_expr($1,$vars));
273			}
274			}
275			next;
276			}
277			if($line =~ /^#if\s+(.+?)$/) { # #if
278			_process_if(\@state, $state[$#state] ? _eval_expr($1,$vars) : 0);
279			next;
280			}
281			if($line =~ /^#ifdef\s+(\w+)/) { # #ifdef
282			my $def = $vars->{$1};
283			_process_if(\@state, ((defined $def) and ($def ne '')));
284			next;
285			}
286
287			$out .= "\n!!! SYNTAX ERROR: UNRECOGNIZED TOKEN !!!\n";
288			}
289
290			return $out;
291			}
292
293			####### TEMPLATE #######
294
295			sub _slurp_file
296			{
297			my $self = shift;
298			my $file = shift;
299
300			#print "<BR>reading $file...<BR>\n";
301
302			my $RS_bak = $/;
303			undef $/;
304			open(SLURP, "<$file") or do {
305			return "\n!!! ERROR: couldn't find $file !!!\n";
306			};
307			my $data = <SLURP> \|\| '';
308			close(SLURP);
309			$/=$RS_bak;
310
311			# replace '\ ' to a special unprobable string
312			$data =~ s/\\ /<<SpAcE>>/g;
313
314			# trim
315			$data =~ s/^[ \t]+//gm;
316			$data =~ s/[ \t]+$//gm;
317
318			# replace the forced-space string to a space
319			$data =~ s/<<SpAcE>>/ /g;
320
321			# strip comments
322			$data =~ s\|^//.*\|\|gm;
323
324			my @ldata = split("\n",$data,-1);
325			return \@ldata;
326			}
327
328			sub _get_template
329			{
330			my $self = shift;
331			my $name = shift;
332
333			my $tdir = $self->{dir};
334			my $suff = $self->{suff};
335
336			if(!exists $self->{cache}{$name}) {
337			my @names = split /\\|/, $name;
338			my $ok = 0;
339			my $filename;
340			foreach (@names) {
341			$filename = "$tdir/$_$suff";
342			if(-r $filename) {
343			$self->{cache}{$name} = $self->_slurp_file($filename);
344			$ok = 1;
345			last;
346			}
347			}
348			if(!$ok) {
349			return ["!!! ERROR: couldn't find a template for $name (t-dir: $tdir) !!!"];
350			}
351			}
352
353			return $self->{cache}{$name};
354			}
355
356			=item C<new($templates_dir, $suffix)>
357
358			Create a new CPPTemplate object. C<$templates_dir> is the directory where the templates
359			are stored and C<$suffix> is a text to append to the file-names.
360
361			=cut
362
363			sub new {
364			my $proto = shift;
365			my $tdir = shift;
366			my $suff = shift;
367
368			my $class = ref($proto) \|\| $proto;
369			my $self = {};
370
371			$self->{cache} = {};
372			$self->{dir}=$tdir;
373			$self->{suff}=$suff;
374
375			bless($self,$class);
376			return $self;
377			}
378
379			=item C<template(\%vars)>
380
381			Return a processed template. C<\%vars> is a hashref containing the variables used for building
382			the file-name, for the substitutions and the CPP-style directives.
383
384			=cut
385
386			sub template($)
387			{
388			my $self = shift;
389			my $vars = shift;
390
391			my $name = $vars->{PAGE}.'_'.$vars->{ELEMENT}.'\|'.
392			$vars->{ELEMENT}.'\|'.
393			$vars->{PAGE}.'\|default';
394
395			# themes:
396			if(defined $vars->{THEME}) {
397			$name = $vars->{THEME}.'/'.$vars->{PAGE}.'_'.$vars->{ELEMENT}.'\|'.
398			$vars->{THEME}.'/'.$vars->{ELEMENT}.'\|'.
399			$vars->{THEME}.'/'.$vars->{PAGE}.'\|'.
400			$vars->{THEME}.'/default'.'\|'.
401			$name;
402			}
403			my $templ = $self->_get_template($name);
404			my $out = $self->_mini_cpp($templ, $vars);
405			chomp $out;
406			return $out;
407			}
408
409			1;
410
411			=back
412
413			=head1 SEE ALSO
414
415			Text::TagTemplate(3)
416
417			=head1 COPYRIGHT
418
419			Copyright (c) 2000 ETH Zurich, All rights reserved.
420
421			=head1 LICENSE
422
423			This program is free software; you can redistribute it and/or modify
424			it under the terms of the GNU General Public License as published by
425			the Free Software Foundation; either version 2 of the License, or
426			(at your option) any later version.
427
428			This program is distributed in the hope that it will be useful,
429			but WITHOUT ANY WARRANTY; without even the implied warranty of
430			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
431			GNU General Public License for more details.
432
433			You should have received a copy of the GNU General Public License
434			along with this program; if not, write to the Free Software
435			Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
436			This library is free software; you can redistribute it and/or
437			modify it under the terms of the GNU Lesser General Public
438			License as published by the Free Software Foundation; either
439			version 2.1 of the License, or (at your option) any later version.
440
441			=head1 AUTHOR
442
443			David Schweikert <dws@ee.ethz.ch>,
444			Tobi Oetiker <oetiker@ee.ethz.ch>