CGI::okTemplate - Perl extension for easy creating websites with using templates

  use CGI::okTemplate;
  my $tmp = new CGI::okTemplate();
  $tmp->read_template('t/test.tpl');
  print $tmp->parse($data);

  use CGI::okTemplate;
  my $tmp = new CGI::okTemplate(File=>'t/test.tpl');
  print $tmp->parse($data);

	{macroname} - name of variable which will be changed to its value

	if {macroname} undefined in currect block
	it will be changed in outer block.
	if {macroname} undefined in outer block also 
	then this tag will be erased from document 
	if function 'new' not receives parameter 'NoClean' 
	or leave as is if parameter 'NoClean' not used

	you can put spaces between '<%' and '{macroname}' and '%>'

	this tag includes file named {filename} into current
	template file.

	{filename} can be relative (to current template path) 
	or absolute path to the file

	this tag defines the start and end of the block
	{BlockTag} can be defined in function 'new' by parameter 'BlockTag'
	default {BlockTag} is 'TemplateBlock'

	{blockname} is the name of block.

	creates new template object

	use CGI::okTemplate;
	my $tmp = new CGI::okTemplate();

	Possible parameters:
		BlockTag - defines the key work for block tags
		File - path to template file (relative or absolute)
		RootDir - dir where all templates have to be under (default is current dir)
		NoClean - says to not clean tags for undefined variables
		Debug - says to put an info into parsed document

	defines template file named $filename to he template object
	this function will overwrite the template data defined in 'new' function
	if that function received 'File' parameter

	parses template with data sctructure $data

	$data is the hash reference (see the section DATA STRUCTURE)

	1) string value - it means that this element
has value for {macroname} of current (or inner) block;

	2) array reference - it means that this element
has array of data for block named my key name;

 Perl Code (example1.pl): 
 -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 #!/usr/bin/perl
 use CGI::okTemplate;
 my $tmpl = new CGI::Template(	File=>'templates/example1.tpl',
				BlockTag=>'Block');

 $data = {
	header => 'value for "header" macro',
	footer => 'value for "footer" macro',
	row => [
		{value => 'value1',},
		{value => 'value2',},
		{value => 'value3',},
	],
 };
 -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

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 = <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/<!--Include\s+(.+?)-->/) {
		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 = <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/<!--($block_tag)\s+(.+?)-->(.*?)<!--\/\1\s+?\2-->/s) {
			my $block_name = $2;
			my $block_text = $3;
			$tmp->{___text___} .= $PREMATCH;
			$text = $POSTMATCH;
			$tmp->{___text___} .= "<!--${block_tag}_parsed $block_name-->";
			$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/<!--(${block_tag}_parsed) (.+?)-->/s) {
			my $block_name = $2;
			my $block;
			$text_result .= $PREMATCH;
			$text_level = $POSTMATCH;
			foreach $block (@{$blocks{$block_name}}) {
				$text_result .= "<!--BlockParsed $block_name-->" if $debug;
				$text_result .= ___parse_data($template->{___blocks___}->{$block_name},$block,$block_tag);
				$text_result .= "<!--/BlockParsed $block_name-->" 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__
# Below is stub documentation for your module. You'd better edit it!