File Coverage

blib/lib/Dotiac/DTL/Addon/html_template.pm

Criterion	Covered	Total	%
statement	96	107	89.7
branch	38	52	73.0
condition	20	25	80.0
subroutine	8	8	100.0
pod	2	2	100.0
total	164	194	84.5

###############################################################################
#html_template.pm
#Last Change: 2009-01-21
#Copyright (c) 2009 Marc-Seabstian "Maluku" Lucksch
#Version 0.4
####################
#This file is an addon to the Dotiac::DTL project.
#http://search.cpan.org/perldoc?Dotiac::DTL
#
#html_template.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 the 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::Addon::html_template;
use strict;
use warnings;
use base qw/Dotiac::DTL::Parser Dotiac::DTL::Addon::html_template_pure/;
use Dotiac::DTL::Core;
require Dotiac::DTL::Tag;
require Dotiac::DTL::Addon;
require Dotiac::DTL::Addon::html_template::Variable;
require Dotiac::DTL::Tag::importloop;

our $VERSION = 0.4;

my @oldparser;
my $first;


sub import {
	push @oldparser,$Dotiac::DTL::PARSER;
	$Dotiac::DTL::PARSER="Dotiac::DTL::Addon::html_template";
	$Dotiac::DTL::Addon::NOCOMPILE{'Dotiac::DTL::Addon::html_template'}=1;
	my $class=shift;
	while (my $a=shift @_) {
		my $o=shift @_;
		if (defined $o and exists $Dotiac::DTL::Addon::html_template_pure::OPTIONS{$a}) {
			$Dotiac::DTL::Addon::html_template_pure::OPTIONS{$a}=$o;
		}
	}
	$first=1;
}

sub unimport {
	$Dotiac::DTL::PARSER=pop @oldparser;
	$first=0;
}


sub new {
	my $class=shift;
	my $self={};
	bless $self,$class;
	return $self;
}


sub parse {
	my $self=shift;
	my $template=shift;
	my $pos=shift;
	my $start=$$pos;
	my @end = @_;
	my $found;
	$found=shift @end if @end;
	local $_;
	while ($Dotiac::DTL::PARSER eq __PACKAGE__) {
		pos($$template) = $$pos;
		if ($$template=~m/[^<\{]*([<\{])/g) {
			my $dtag=$1; #Decisive tag :)
			my $pre = substr $$template,$start,pos($$template)-$start-1;
			if ($dtag eq "{") {
				my $n = substr $$template,pos($$template),1;
				$$pos=pos($$template)+1;
				if ($n eq "%") {
					my $npos = index($$template,"%}",$$pos);
					die "Missing closing %} at char $$pos" if $npos < 0;
					my $cont=substr $$template,$$pos,$npos-$$pos;
					$$pos=$npos+2;
					$cont=~s/^\s+//;
					$cont=~s/\s+$//;
					my ($tagname,$param) = split /\s+/,$cont,2;
					$tagname=lc $tagname;
					$$found = $tagname and return Dotiac::DTL::Tag->new($pre) if $found and grep {$_ eq $tagname} @end;
					my $r;
					eval {$r="Dotiac::DTL::Tag::$tagname"->new($pre,$param,$self,$template,$pos);};
					if ($@) {
						die "Error while loading Tag '$tagname' from Dotiac::DTL::Tag::$tagname. If this is an endtag (like endif) then your template is unbalanced\n$@";
					}
					if ($$pos >= length $$template) {
						$r->next(Dotiac::DTL::Tag->new(""));
					}
					else {
						$r->next($self->parse($template,$pos,@_));
					}
					if (not $start or $first) {
							$first=0;
							return $r if lc($Dotiac::DTL::Addon::html_template_pure::OPTIONS{default_escape}) eq "html";
							return bless {p=>"",n=>Dotiac::DTL::Tag->new(""),escape=>0,content=>$r},"Dotiac::DTL::Tag::autoescape"; #Autoescape off unless default_escape == html
					}
					return $r;

				}
				elsif ($n eq "{") {
					my $npos = index($$template,"}}",$$pos);
					die "Missing closing }} at char $$pos" if $npos < 0;
					my $cont=substr $$template,$$pos,$npos-$$pos;
					$$pos=$npos+2;
					return Dotiac::DTL::Variable->new($pre,$cont,$self->parse($template,$pos,@_));
				}
				elsif ($n eq "#") {
					my $npos = index($$template,"#}",$$pos);
					die "Missing closing #} at char $$pos" if $npos < 0;
					my $cont=substr $$template,$$pos,$npos-$$pos;
					$$pos=$npos+2;
					return Dotiac::DTL::Comment->new($pre,$cont,$self->parse($template,$pos,@_));
				}
			}
			else {
				#my $p=
				if($$template=~m/\G(?:!--\s*)?
				([\/]?)\s*
				[Tt][Mm][Pp][Ll]_((?:[Vv][Aa][Rr])|(?:[Ii][Ff])|(?:[Ee][Ll][Ss][Ee])|(?:[Uu][Nn][Ll][Ee][Ss][Ss])|(?:[Ll][Oo][Oo][Pp])|(?:[Ii][Nn][Cc][Ll][Uu][Dd][Ee]))
				\s*(
				    (?:
					(?:
					    (?:(?:[Dd][Ee][Ff][Aa][Uu][Ll][Tt])|(?:[Ee][Ss][Cc][Aa][Pp][Ee])|(?:[Nn][Aa][Mm][Ee]))
					    \s*=\s*
					)?
					(?!-->)(?:(?:"[^">]*")|(?:'[^'>]*')|(?:[^\s=>]*))\s*
				    )*
				)
				(?:--)?>/sgx) {
					my $end=$1;
					my $tag=lc($2);
					my $content=$3;
					$$pos=pos($$template);
					my $tagname=$tag;
					$tagname="end$tag" if $end;
					$tagname="endimportloop" if $end and $tag eq "loop";
					$tagname="endif" if $end and $tag eq "unless";
					$$found = $tagname and return Dotiac::DTL::Tag->new($pre) if $found and grep {$_ eq $tagname} @end;
					my $t=$self->maketag($tag,$content,$pre,$template,$pos);
					if ($t) {
						if ($$pos >= length $$template) {
							$t->next(Dotiac::DTL::Tag->new(""));
						}
						else {
							$t->next($self->parse($template,$pos,@_));
						}
						if (not $start or $first) {
							$first=0;
							return $t if lc($Dotiac::DTL::Addon::html_template_pure::OPTIONS{default_escape}) eq "html";
							return bless {p=>"",n=>Dotiac::DTL::Tag->new(""),escape=>0,content=>$t},"Dotiac::DTL::Tag::autoescape"; #Autoescape off unless default_escape == html
						}
						return $t;
					}
					else {
						warn "Couldn't make anything with $tag,$tagname, maybe your template is unbalanced";
					}
				}
				else {
					#die;# $p;
					$$pos++;
				}
			}
		}
		else {
			$$pos=length $$template;
			return Dotiac::DTL::Tag->new(substr $$template,$start);
		}

	}
	my $parser=$Dotiac::DTL::PARSER->new();
	my @args=($template,$pos);
	push @args,$found if $found;
	push @args,@end if @end;
	return $parser->parse(@args);
}


1;
__END__