File Coverage

blib/lib/Dotiac/DTL.pm

Criterion	Covered	Total	%
statement	93	123	75.6
branch	24	54	44.4
condition	15	33	45.4
subroutine	8	10	80.0
pod	4	4	100.0
total	144	224	64.2

###############################################################################
#DTL.pm
#Last Change: 2008-01-19
#Copyright (c) 2006 Marc-Seabstian "Maluku" Lucksch
#Version 0.8
####################
#This file is part of the Dotiac::DTL project.
#http://search.cpan.org/perldoc?Dotiac::DTL
#
#DTL.pm is published under the terms of the MIT license, which basically
#means "Do with it whatever you want". For more information, see the
#license.txt file that should be enclosed with libsofu distributions. A copy of
#the license is (at the time of writing) also available at
#http://www.opensource.org/licenses/mit-license.php .
###############################################################################


package Dotiac::DTL;
use base qw/Dotiac::DTL::Core/; #This is only used to make Test::Pod::Coverage, since most functions in the Dotiac::DTL namespace are documented in that file.
require Dotiac::DTL::Tag;
require Digest::MD5;
use Carp qw/confess/;
use strict;
use warnings;
use Exporter;
require File::Spec;
require File::Basename;

our @EXPORT=();
our @EXPORT_OK=qw/Context Template/;
our $VERSION = 0.8;



sub Template {
	my $file=shift;
	if (-e $file) {
	}
	elsif (-e "$file.html") {
		$file="$file.html"
	}
	elsif (-e "$file.txt") {
		$file="$file.txt" ;
	}
	else {
		foreach my $dir (@Dotiac::DTL::TEMPLATE_DIRS) {
			$file=File::Spec->catfile($dir,"$file.html") and last if -e File::Spec->catfile($dir,"$file.html");
			$file=File::Spec->catfile($dir,"$file.txt") and last if -e File::Spec->catfile($dir,"$file.txt");
			$file=File::Spec->catfile($dir,$file) and last if -e File::Spec->catfile($dir,$file);
		}
	}
	return Dotiac::DTL->new($file,@_) if -e $file;
	return Dotiac::DTL->new(\$file,@_);
}


sub Context {
	return $_[0];
}

my %cache;
sub newandcompile {
	my $class=shift;
	return $class->new(@_,1);
}

{
	no warnings "redefine";
	sub new {
		%Dotiac::DTL::params=();
		my $class=shift;
		my $data=shift;
		my $t="";
		my $filename="from cache";
		my $changetime=0;
		my $compile=shift; #1 compile, 0 no recompile, -1 skip compiled even if its there, undef=use compiled if there, recompile if needed.
		if (ref $data eq "SCALAR") {
			$t=$$data;
			$compile=0;
			$filename="form SCALARref";
			$Dotiac::DTL::currentdir=$Dotiac::DTL::CURRENTDIR;
		}
		elsif (not ref $data) {
			$t=$data;
			my @f = File::Basename::fileparse($data);
			$Dotiac::DTL::currentdir=$f[1];
			#warn "Cached:",Data::Dumper->Dump([\%cache]);
			if (-e "$data.pm" and (($compile and $compile > 0) or not defined $compile)) {
				if (-e $data) {
					if ((stat("$data.pm"))[9] > (stat("$data"))[9]) {

						eval {
							$cache{"$data.pm"}={
								template=>Dotiac::DTL::Compiled->new("Dotiac::DTL::Compiled::".require "$data.pm"),
								currentdir=>$Dotiac::DTL::currentdir,
								params=>{%Dotiac::DTL::params},
								parser=>$Dotiac::DTL::PARSER,
								changetime=>(stat("$data.pm"))[9]
							} if not $cache{"$data.pm"};# or (exists $cache{"$data.pm"}->{changetime} and $cache{"$data.pm"}->{changetime} > -M "$data.pm");
							$t="$data.pm";
							$compile=0;
							1;
						} or do {
							carp "Error while getting compiled template $data.pm:\n $@\n.";
							undef $@;
						};
					}
					else {
						delete $cache{"$data.pm"};
						delete $INC{"$data.pm"}; #Otherwise it won't work.
						$compile=1 if $compile or not defined $compile;
					}
				}
				else { # $data is not more here, but $data.pm is, use that one than.
					if ($cache{"$data.pm"} and exists $cache{"$data.pm"}->{changetime} and $cache{"$data.pm"}->{changetime} < (stat("$data.pm"))[9]) {
						carp "Foo";
						delete $cache{"$data.pm"};
						delete $INC{"$data.pm"};
					}
					eval {
						$cache{"$data.pm"}={
							template=>Dotiac::DTL->compiled("Dotiac::DTL::Compiled::".require "$data.pm"),
							currentdir=>$Dotiac::DTL::currentdir,
							params=>{%Dotiac::DTL::params},
							parser=>$Dotiac::DTL::PARSER,
							changetime=>(stat("$data.pm"))[9]
						} if not $cache{"$data.pm"};# or (exists $cache{"$data.pm"}->{changetime} and $cache{"$data.pm"}->{changetime} > -M "$data.pm");
						$t="$data.pm";
						$compile=0;
						1;
					} or do {
						croak "Error while getting compiled template $data.pm and $data is gone:\n $@\n.";
						undef $@;
					};
				}
			}
			if ($cache{$t} and $t eq $data and exists $cache{$t}->{changetime} and $cache{$t}->{changetime} < (stat("$t"))[9]) {
				delete $cache{$t};
			}
			unless ($cache{$t})  {
				open my $fh,"<",$data or croak "Can't open template $data: $!";
				binmode $fh;
				my $a=do {local $/,<$fh>};
				close $fh;
				$filename="\"$data\"";
				$changetime=(stat("$data"))[9];
				$data=\$a;
			}
		}
		else {
			die "Can't work with $data!";
		}
		unless ($cache{$t}) {
			eval "require $Dotiac::DTL::PARSER;" or croak "Can't load Parser '$Dotiac::DTL::PARSER': $@";
			my $parser=$Dotiac::DTL::PARSER->new();
			$cache{$t}={
				template=>Dotiac::DTL::Tag->new("include/extend cycle detected"), #This prevents cycled includes to screw around during parsing time.
				currentdir=>$Dotiac::DTL::currentdir,
				params=>{%Dotiac::DTL::params},
				parser=>$Dotiac::DTL::PARSER
			};
			my $pos=0;
			eval {
				$cache{$t}={
					template=>$parser->parse($data,\$pos),
					currentdir=>$Dotiac::DTL::currentdir,
					params=>{%Dotiac::DTL::params},
					parser=>$Dotiac::DTL::PARSER,
					changetime=>$changetime
				};
				1;
			} or do {
				croak "Error while getting template $filename:\n $@\n.";
				undef $@;
			};
		}
		if ($compile and $compile > 0) {
			if (open my $cp,">","$t.pm") {
				eval {
					require Data::Dumper;
					$Data::Dumper::Indent=2;
					$Data::Dumper::Useqq=1;
					my $template=$cache{$t}->{template};
					my $digest=Digest::MD5::md5_hex($t);
					print $cp "#Autogenerated\n";
					print $cp "package Dotiac::DTL::Compiled::$digest;\nuse strict;\nuse warnings;\nrequire Scalar::Util;\n#PARAMS USED:\nour ";

					print $cp (Data::Dumper->Dump([$cache{$t}->{params}],["\$params"]));
					$template->perl($cp,0,$digest);
					print $cp "\n#INIT\n";
					$template->perlinit($cp,0,$digest);
					print $cp "\nsub string {\n	my \$vars=shift;\n	my \$escape=shift;\n	my \$r=\"\";\n";
					$template->perlstring($cp,0,1,$digest);
					print $cp "	return \$r;\n}\n";
					print $cp "sub print {\n	my \$vars=shift;\n	my \$escape=shift;\n";
					$template->perlprint($cp,0,1,$digest);
					print $cp "}\n";
					print $cp "sub eval {\n	my \$vars=shift;\n	my \$escape=shift;\n";
					$template->perleval($cp,0,1,$digest);
					print $cp "}\n";
					print $cp qq("$digest";);
					close $cp;
					1;
				} or do {
					croak "Error while compiling template $filename:\n $@\n.";
					undef $@;
				};
			}
			else {
				carp "Can't open output to $$data.pm while compiling: $!";
			}
		}
		Dotiac::DTL::Addon::restore();
		return "Dotiac::DTL::Template"->new($cache{$t}->{template},$cache{$t}->{currentdir},$cache{$t}->{parser},$cache{$t}->{params});
	}
}
1;

__END__