File Coverage

blib/lib/CGI/okTemplate.pm

Criterion	Covered	Total	%
statement	129	142	90.8
branch	23	44	52.2
condition	4	9	44.4
subroutine	15	15	100.0
pod	3	3	100.0
total	174	213	81.6

package CGI::okTemplate;

use 5.008004;
use strict;
use Carp;
use English;
use warnings;
use File::Spec;

require Exporter;

our @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.

# This allows declaration	use CGI::okTemplate ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.03';

our $debug=0;

# Preloaded methods go here.

sub new {
	my $class = shift;
	my $self = {};

	bless($self,$class);
	$self->{___params} = {@_};
	$debug = 1 if $self->{___params}->{Debug};
	$self->{___params}->{BlockTag} = 'TemplateBlock' unless $self->{___params}->{BlockTag};
	if($self->{___params}->{RootDir}) {
		$self->{___params}->{RootDir} = File::Spec->rel2abs($self->{___params}->{RootDir});
	} else {
		$self->{___params}->{RootDir} = File::Spec->rel2abs(File::Spec->curdir());
	}
	$self->{___params}->{RootDir} = ___clean_up_dirs(File::Spec->canonpath($self->{___params}->{RootDir}));
	confess "Root Dir '$self->{___params}->{RootDir}' does not exists\n" unless (-d $self->{___params}->{RootDir});
	$self->read_template($self->{___params}->{File}) if($self->{___params}->{File});

	return $self;
}

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

	unless($file) {
		confess "Parameter 'File' undefined in function 'read_template.'\n";
	}

	unless(File::Spec->file_name_is_absolute( $file )) { # make absolute path to file
		$file = File::Spec->catfile($self->{___params}->{RootDir},$file);
	}

	$file = ___clean_up_dirs(File::Spec->canonpath($file)); # delete up dirs from path
	confess "File '$file' does not exists\n" unless (-r $file);

	unless(___under_root($self->{___params}->{RootDir},$file)) {
		confess "File '$file' does not under root dir '$self->{___params}->{RootDir}'\n";
	}

	$self->{___params}->{File} = $file;

	local($/) = undef;
	open IN, $file;
	my $in = ;
	close IN;

	my $cur_path = ___get_dir($file);
	$in = ___read_includes($in,$cur_path,$self->{___params}->{RootDir});

	$self->{___template___} = ___parse_template($in,$self->{___params}->{BlockTag},$cur_path,$self->{___params}->{RootDir});
}

sub ___read_includes {
	my $text = shift;
	my $cur_path = shift;
	my $root_path = shift;
	while($text =~ m//) {
		my $pre_inc = $PREMATCH; # text before include
		my $post_inc = $POSTMATCH; # text after include
		my $include_filename = $1; # got include filename
		unless(File::Spec->file_name_is_absolute( $include_filename )) {
			$include_filename = File::Spec->catfile($cur_path,$include_filename);
		}
		$include_filename = ___clean_up_dirs(File::Spec->canonpath($include_filename)); # delete up dirs from path
		unless(___under_root($root_path,$include_filename) && (-r $include_filename)) {
			$text = $pre_inc;
			if($debug) {
				$text .=
				"File '$include_filename' can't be included" .
				" in this document because of wrong file path";
			}
			$text .= $post_inc;
		} else {
			my $in = '';
			local($/) = undef;
			open IN, "< $include_filename";
			$in = ;
			close IN;
			my $new_cur_path = ___get_dir($include_filename);
			$text = $pre_inc . ___read_includes($in,$new_cur_path,$root_path) . $post_inc;
		}
	}
	return $text;
}

sub ___clean_up_dirs {
	my $path = shift;
	my ($vol, $dirs, $file) = File::Spec->splitpath( $path, 1 );
	my @path = File::Spec->splitdir( $dirs );
	my $i;

	for($i = 0; $i<$#path; $i++) {
		if($path[$i] eq File::Spec->updir()) {
			if($i) { # not first folder
				$i--; # go 1 step up
			} else { # first folder
				shift @path;
			}
			redo;
		}
		if($path[$i+1] eq File::Spec->updir()) {
			splice @path, $i, 2;
			redo;
		}
	}

	return File::Spec->catpath($vol,File::Spec->catdir(@path),$file);
}


sub ___under_root {
	my $root = shift;
	my $file = shift;

	return $file =~ /^($root)/;
}

sub ___get_dir {
	my $path = shift;
	my ($vol, $dirs, $file) = File::Spec->splitpath( $path );

	return File::Spec->catpath($vol,$dirs,''); # remove file
}



sub parse {
	my $self = shift;
	my $data = shift || {};
	my $res;

	$res = ___parse_data($self->{___template___},$data,$self->{___params}->{BlockTag});
	$res =~ s/<%.*?%>//g unless $self->{___params}->{NoClean};

	return $res;
}

sub ___parse_template {
	my $text = shift;
	my $block_tag = shift;
	my $cur_path = shift;
	my $root_path = shift;
	my $tmp = {___text___=>'',___blocks___=>{}};
	while($text) {
		if($text =~ m/(.*?)/s) {
			my $block_name = $2;
			my $block_text = $3;
			$tmp->{___text___} .= $PREMATCH;
			$text = $POSTMATCH;
			$tmp->{___text___} .= "";
			$tmp->{___blocks___}->{$block_name} = ___parse_template($block_text,$block_tag);
		} else {
			$tmp->{___text___} .= $text;
			$text = undef;
		}
	}
	return $tmp;
}

sub ___parse_data {
	my $template = shift || {};
	my $data = shift || {};
	my $block_tag = shift;
	my $text_level = $template->{___text___};
	my $text_result = '';
	my %data = ();
	my %blocks = ();
	my $key;
	foreach $key (keys %$data) {
		if(ref $data->{$key}) {
			$blocks{$key} = $data->{$key};
		} else {
			$data{$key} = $data->{$key};
		}
	}
	while($text_level) {
		if($text_level =~ m//s) {
			my $block_name = $2;
			my $block;
			$text_result .= $PREMATCH;
			$text_level = $POSTMATCH;
			foreach $block (@{$blocks{$block_name}}) {
				$text_result .= "" if $debug;
				$text_result .= ___parse_data($template->{___blocks___}->{$block_name},$block,$block_tag);
				$text_result .= "" if $debug;
			}
		} else {
			$text_result .= $text_level;
			$text_level = undef;
		}
	}

	# put local macro value or leave for global value changes
	$text_result =~ s/<%\s*(.+?)\s*%>/(exists $data{$1}) ?  $data{$1} : "<% $1 %>"/ge;
	return $text_result;
}

1;
__END__