File Coverage

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

Criterion	Covered	Total	%
statement	148	159	93.0
branch	74	88	84.0
condition	29	38	76.3
subroutine	9	10	90.0
pod	3	4	75.0
total	263	299	87.9

###############################################################################
#html_template_pure.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_pure.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_pure;
use strict;
use warnings;
use Dotiac::DTL::Core;
use base qw/Dotiac::DTL::Parser/;
require Dotiac::DTL::Tag;
require Dotiac::DTL::Addon::html_template::Variable;
require Dotiac::DTL::Tag::autoescape;
require Dotiac::DTL::Tag::if;
require Dotiac::DTL::Tag::importloop;
require Dotiac::DTL::Tag::include;

our $VERSION = 0.4;
our %OPTIONS=(
	loop_context_vars=>1,
	global_vars=>1,
	default_escape=>""
);

my @oldparser;



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

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

sub maketag {
	my $self=shift;
	my $tag=shift;
	my $opts=shift;
	my $pre=shift;
	my @opts=();
	@opts=split /\s*((?:(?:[Dd][Ee][Ff][Aa][Uu][Ll][Tt])|(?:[Ee][Ss][Cc][Aa][Pp][Ee])|(?:[Nn][Aa][Mm][Ee]))\s*=)\s*/,$opts if $opts;
	my %opts=();
	#Convert options, quick and dirty
	while (defined(my $o=shift(@opts))) {
		next unless $o;
		if (substr($o,-1,1) ne "=") {
			push @{$opts{"name"}},$o;
		}
		else {
			$o=~s/\s*=$//;
			$o=lc $o;
			push @{$opts{$o}},shift(@opts);
		}

	}
	if ($opts{default}) {
		foreach my $value (@{$opts{default}}) {
			my $f=substr $value,0,1;
			my $e=substr $value,-1,1;
			if ($f eq $e and $f eq '"' or $f eq "'") {
				$value=substr $value,1,-1;
			}
			$value=Dotiac::DTL::escap($value);
		}
	}
	if ($opts{name}) {
		foreach my $value (@{$opts{name}}) {
			$value=~s/["'\\\s}{]//g;
		}
	}
	if ($opts{escape}) {
		foreach my $value (@{$opts{escape}}) {
			$value=~s/\W//g;
			$value=~tr/A-Z/a-z/;
		}
	}
	my $template=shift;
	my $pos=shift;
	if ($tag eq "var") {
		my @filter;
		push @{$opts{escape}},lc($Dotiac::DTL::Addon::html_template_pure::OPTIONS{default_escape}) if not ($opts{escape}) and $Dotiac::DTL::Addon::html_template_pure::OPTIONS{default_escape} and lc($Dotiac::DTL::Addon::html_template_pure::OPTIONS{default_escape}) ne "html";
		if ($opts{escape}) {
			foreach my $v (@{$opts{escape}}) {
				if ($v eq "js") {
					push @filter,"escapejs";
					push @filter,"safe" if lc($Dotiac::DTL::Addon::html_template_pure::OPTIONS{default_escape}) eq "html";
				}
				if ($v eq "html") {
					push @filter,"escape";
				}
				if ($v eq "url") {
					push @filter,"urlencode";
					push @filter,"safe" if lc($Dotiac::DTL::Addon::html_template_pure::OPTIONS{default_escape}) eq "html";
				}
				if ($v eq "0" or $v eq "" or $v eq "off" or $v eq "none") {
					push @filter,"safe" if lc($Dotiac::DTL::Addon::html_template_pure::OPTIONS{default_escape}) eq "html";
				}
			}
		}
		if ($opts{default}) {
			push @filter,"default:".shift(@{$opts{default}});
		}
		my $name="``";
		if ($opts{name}) {
			$name=shift @{$opts{name}};
		}
		return Dotiac::DTL::Addon::html_template::Variable->new($pre,$name,\@filter);
	}
	elsif ($tag eq "if") {
		my $found="";
		my $name="``";
		if ($opts{name}) {
			$name=shift @{$opts{name}};
		}
		my $true=$self->parse($template,$pos,\$found,"else","endif");
		if ($found eq "else") {
			return bless {'cond'=>[$name],true=>$true,false=>$self->parse($template,$pos,\$found,"endif"),p=>$pre},"Dotiac::DTL::Tag::if";
		}
		return bless {'cond'=>[$name],true=>$true,p=>$pre},"Dotiac::DTL::Tag::if";
	}
	elsif ($tag eq "unless") {
		my $found="";
		my $name="``";
		if ($opts{name}) {
			$name=shift @{$opts{name}};
		}
		my $true=$self->parse($template,$pos,\$found,"else","endif");
		if ($found eq "else") {
			return bless {'not'=>[$name],true=>$true,false=>$self->parse($template,$pos,\$found,"endif"),p=>$pre},"Dotiac::DTL::Tag::if";
		}
		return bless {'not'=>[$name],true=>$true,p=>$pre},"Dotiac::DTL::Tag::if";
	}
	elsif ($tag eq "loop") {
		my $found="";
		my $name="``";
		if ($opts{name}) {
			$name=shift @{$opts{name}};
		}
		my $content=$self->parse($template,$pos,\$found,"endimportloop","empty");
		if ($found eq "empty") {
			return bless {source=>$name,content=>$content,p=>$pre,empty=>$self->parse($template,$pos,\$found,"endimportloop"),merge=>$Dotiac::DTL::Addon::html_template_pure::OPTIONS{global_vars},contextvars=>$Dotiac::DTL::Addon::html_template_pure::OPTIONS{loop_context_vars}},"Dotiac::DTL::Tag::importloop";
		}
		return bless {source=>$name,content=>$content,p=>$pre,merge=>$Dotiac::DTL::Addon::html_template_pure::OPTIONS{global_vars},contextvars=>$Dotiac::DTL::Addon::html_template_pure::OPTIONS{loop_context_vars}},"Dotiac::DTL::Tag::importloop";
	}
	elsif ($tag eq "include") {
		my $name;
		if ($opts{name}) {
			$name=shift @{$opts{name}};
		}
		return Dotiac::DTL::Addon::html_template::Variable->new($pre,"``",[]) unless $name;
		return eval {
			my $tem = Dotiac::DTL->safenew($name);
			return bless {content=>$tem->{first},load=>$name,p=>$pre},"Dotiac::DTL::Tag::include";
		} || Dotiac::DTL::Addon::html_template::Variable->new($pre,"``",[]);
	}
	return undef;

}


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(.*?)<(?:!--\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 $pre=$1;
			my $end=$2;
			my $tag=lc($3);
			my $content=$4;
			$$pos=pos($$template);
			#warn "Pre:$pre\nTag:$tag,End:$end\nContent=$content\nStart=$start, end=$$pos" if $tag eq "if";
			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,@_));
				}
				unless ($start) {
					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 {
			$$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);
}

sub unparsed { #This isn't needed here.
	return "";
}

1;
__END__