File Coverage

blib/lib/HTML/SimpleTemplate.pm

Criterion	Covered	Total	%
statement	76	94	80.8
branch	36	48	75.0
condition	1	3	33.3
subroutine	5	5	100.0
pod	0	2	0.0
total	118	152	77.6

package HTML::SimpleTemplate;

# (C)1998-2003 Andrew Crawford
#
# A quicker (for the programmer!) and simpler template system for
# people who like simple things.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#

use strict;
use Symbol;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# We don't need no stinkin' exports

$VERSION = '1.00';

sub new
{
	my $type = shift;
	my $class = ref($type) || $type;
	my $filepath=shift;
	my $self={"FILEPATH"=>$filepath};
	bless ($self,$class);
	return $self;
}

sub Display
{
	my $self = shift;
	my $filename = shift;
	my @ifstate=(1);
	my $fh = Symbol::gensym();
	my $blockelse;

	if ($self->{FILEPATH})
	{
		open ($fh,$self->{FILEPATH}."/$filename") || return;
	} else {
		open ($fh,"$filename") || return;
	}

	my $bundle = shift; # a reference to the hash with the variables in

	${$bundle}{TemplatePath} = $self->{FILEPATH};

	while(<$fh>) # for each line of the template file...
	{

		# # some comment not sent to output
		if (/^\#/) # skip it if it's a comment
		{
			next;
		}



		# ?$ShowImage
		if (/^\?\$(\S+)/)	# Simple if clause
	      	{

			if (!$ifstate[0])
			{
				$blockelse++;
				next;
			}

			if (${$bundle}{$1})
			{
		  		unshift @ifstate,1;
			} else {
				unshift @ifstate,0;
			}

 			next;
      		 }

		# ?($name=~/Bishop/)
		if (/^\?\((.+)\)$/)	# Complex if clause
		{

			if (!$ifstate[0])
			{
				$blockelse++;
				next;
			}

			my $cond=$1; 	# the condition

			$cond=~s/\$(\w+)/\$\{\$bundle\}\{$1\}/g;
					# interpolate string

			if(eval($cond))
			{
				unshift @ifstate,1 ;
			} else {
				unshift @ifstate,0 ;
			}

			next;
		}

		# ?!$ShowImage
		if(/^\?\!\$(\S+)/)  # Simple if NOT clause
		{
  	  		if (${$bundle}{$1})
  	  		{
   	    			unshift @ifstate,0;
		  	} else {
		    		unshift @ifstate,1;
	  		}

			next;
		}

		# ?else
		if (/^\?else/) # ELSE command - swap ifstate
		{
			if ($blockelse)
			{
				next;
			}

			if ($ifstate[0]==0)
			{
				$ifstate[0]=1;
			} else {
				$ifstate[0]=0;
			}
	    		next;
		}

		# ?exit
		if (/^\?exit/) # EXIT command - quit processing
		{
			if ($ifstate[0])
			{
				close($fh);
				return;
			}
		}

		if (/^\?end/)	# End of an if block
      		{
			if ($blockelse)
			{
				$blockelse--;
				next;
			}

			shift(@ifstate);

			if (!defined @ifstate)
			{
				# Allow for too many ?ends
				@ifstate=(1);
			}
			next;
      		}



		# Add callbacks to perl procedures
		# &SomeFunc($a,3)
		if (/^\&([^\)]+)\(([^\)]+)/)
		{
			my $params=$2;
			my $command=$1;

			$params=~s/\$(\w+)/${$bundle}{$1}/g;
			$command=~s/\$(\w+)/${$bundle}{$1}/g;

			$params=~s/\"/\\\"/g;

			eval"$command($params);";
			next;
		}


	    	# Substitute template variables where ever found

		s/\$(\w+)/${$bundle}{$1}/g;
		s/\$\{(\w+)\}/${$bundle}{$1}/g;

		# !another.tpl
		if (/^\!(\S+)/)	# Include other tpl file
		{
			if ($ifstate[0])
			{
				Display($self,$1,$bundle);
			    	next;
	  		}
      		}

		# Print the processed line if appropriate

		if ($ifstate[0])
		{
		 	print;
		}

	}

	close($fh);
}


# Preloaded methods go here.
# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__