File Coverage

blib/lib/HTML/KTemplate.pm

Criterion	Covered	Total	%
statement	279	293	95.2
branch	184	226	81.4
condition	42	69	60.8
subroutine	20	22	90.9
pod	10	10	100.0
total	535	620	86.2

#=======================================================================
#
#   Copyright (c) 2002-2003 Kasper Dziurdz. All rights reserved.
#
#   This module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
#
#   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
#   Artistic License for more details.
#
#   Please email me any comments, questions, suggestions or bug
#   reports to:
#
#=======================================================================

package HTML::KTemplate;
use strict;
use Carp;
use File::Spec;

use vars qw(
	$VAR_START_TAG $VAR_END_TAG
	$BLOCK_START_TAG $BLOCK_END_TAG
	$INCLUDE_START_TAG $INCLUDE_END_TAG
	$ROOT $CHOMP $VERSION $CACHE
	$FIRST $INNER $LAST
);

$VERSION = '1.33';

$VAR_START_TAG = '[%';
$VAR_END_TAG   = '%]';

$BLOCK_START_TAG = '';

$INCLUDE_START_TAG = '';

$ROOT  = undef;
$CHOMP = 1;
$CACHE = {};

$FIRST = { 'FIRST' => 1, 'first' => 1 };
$INNER = { 'INNER' => 1, 'inner' => 1 };
$LAST  = { 'LAST'  => 1, 'last'  => 1 };


sub TEXT   () { 0 }
sub VAR    () { 1 }
sub BLOCK  () { 2 }
sub FILE   () { 3 }
sub IF     () { 4 }
sub ELSE   () { 5 }
sub UNLESS () { 6 }
sub LOOP   () { 7 }

sub TYPE   () { 0 }
sub IDENT  () { 1 }
sub STACK  () { 2 }

sub NAME   () { 0 }
sub PATH   () { 1 }


sub new {

	my $class = shift;
	my $self = {
		'vars'   => [{}],  # values for template vars
		'loop'   => [],    # loop context variables
		'block'  => undef, # current block reference
		'files'  => [],    # file paths for include
		'output' => '',    # template output
		'config' => {      # configuration
			'cache'        => 0,
			'strict'       => 0,
			'no_includes'  => 0,
			'max_includes' => 15,
			'loop_vars'    => 0,
			'blind_cache'  => 0,
			'include_vars' => 0,
			'parse_vars'   => 0,
		},
	};

	$self->{'config'}->{'root'} = shift if @_ == 1;
	croak('Odd number of option parameters') if @_ % 2 != 0;

	# load in all option parameters
	$self->{'config'}->{$_} = shift while $_ = lc shift;

	$self->{'config'}->{'root'} = $ROOT
		unless exists $self->{'config'}->{'root'};

	$self->{'config'}->{'cache'} = 1
		if $self->{'config'}->{'blind_cache'};

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

}


sub assign {

	my $self = shift;
	my ($target, $block);

	# odd number of arguments: block
	if (@_ % 2 != 0 && @_ >= 3) {
		$self->block(shift);
		++$block;
	}

	# if a block reference is defined,
	# assign the variables to the block
	$target = defined $self->{'block'}
		? $self->{'block'}->[ $#{ $self->{'block'} } ]
		: $self->{'vars'}->[0];

	if (ref $_[0] eq 'HASH') {
		# copy data for faster variable lookup
		@{ $target }{ keys %{$_[0]} } = values %{$_[0]};
	} else {
		my %assign = @_;
		@{ $target }{ keys %assign } = values %assign;
	}

	# remove block reference
	$self->block() if $block;

	return 1;

}


sub block {
# - creates a new loop in the defined block
# - sets a reference so all future variable values will
#   be assigned there (until this method is called again)

	my $self = shift;
	my (@ident, $root, $key, $last_key);

	# no argument: undefine block reference
	if (!defined $_[0] || !length $_[0]) {
		$self->{'block'} = undef;
		return 1;
	}

	push @ident, split /\./, shift while @_;
	$last_key = pop @ident;

	$root = $self->{'vars'}->[0];

	foreach $key (@ident) {

		# hash reference: perfect!
		if (ref $root->{$key} eq 'HASH') {
		$root = $root->{$key};
		}

		# array reference: block continues in hash
		# reference at the end of the array
		elsif (ref $root->{$key} eq 'ARRAY'
		  && ref $root->{$key}->[ $#{ $root->{$key} } ] eq 'HASH' ) {
		$root =  $root->{$key}->[ $#{ $root->{$key} } ];
		}

		else { # create new hash reference
		$root = $root->{$key} = {};
		}

	}

	if (ref $root->{$last_key} eq 'ARRAY') {
		# block exists: add new loop
		push @{ $root->{$last_key} }, {};
	} else {
		# create new block
		$root->{$last_key} = [{}];
	}

	$self->{'block'} = $root->{$last_key};

	return 1;

}


sub process {

	my $self = shift;

	foreach (@_) {
		next unless defined;
		$self->_include($_);
	}

	return 1;

}


sub _include {

	my $self = shift;
	my $filename = shift;
	my ($stack, $filepath);

	# check whether includes are disabled
	if ($self->{'config'}->{'no_includes'} && scalar @{ $self->{'files'} } != 0) {
		croak('Include blocks are disabled at ' . $self->{'files'}->[0]->[NAME])
			if $self->{'config'}->{'strict'};
		return; # no strict
	}

	# check for recursive includes
	croak('Recursive includes: maximum recursion depth of ' . $self->{'config'}->{'max_includes'} . ' files exceeded')
		if scalar @{ $self->{'files'} } > $self->{'config'}->{'max_includes'};

	($stack, $filepath) = $self->_load($filename);

	# add file path to use as include path
	unshift @{ $self->{'files'} }, [ $filename, $filepath ]
		if defined $filepath;

	# create output
	$self->_output($stack);

	# delete file info if it was added
	shift @{ $self->{'files'} }	if defined $filepath;

}


sub _load {
# - loads the template file from cache or hard drive
# - returns the parsed stack and the full template path

	my $self = shift;
	my $filename = shift;
	my ($filepath, $mtime, $filedata);

	# slurp the file
	local $/ = undef;

	# when the passed argument is a reference to a scalar,
	# array or file handle, load and use it as template

	if (ref $filename eq 'SCALAR') {
		# skip undef and do not change passed scalar
		$filedata = defined $$filename ? $$filename : '';
		return $self->_parse(\$filedata, '[scalar_ref]');
	}

	if (ref $filename eq 'ARRAY') {
		$filedata = join("", @$filename);
		return $self->_parse(\$filedata, '[array_ref]');
	}

	if (ref $filename eq 'GLOB') {
		$filedata = readline($$filename);
		$filedata = '' unless defined $filedata; # skip undef
		return $self->_parse(\$filedata, '[file_handle]');
	}

	# file handle (no reference)
	if (ref \$filename eq 'GLOB') {
		$filedata = readline($filename);
		$filedata = '' unless defined $filedata; # skip undef
		return $self->_parse(\$filedata, '[file_handle]');
	}

	($filepath, $mtime) = $self->_find($filename);

	croak("Can't open file $filename: file not found")
		unless defined $filepath;

	if ($self->{'config'}->{'cache'}) {
		# load parsed template from cache
		$filedata = $CACHE->{$filepath};

		return ($filedata->[0], $filepath)
			if $self->{'config'}->{'blind_cache'} && defined $filedata;
		return ($filedata->[0], $filepath)
			if defined $filedata && $filedata->[1] == $mtime;
	}

	open (TEMPLATE, '<' . $filepath) ||
		croak("Can't open file $filename: $!");
	$filedata =