File Coverage

blib/lib/Dotiac/DTL/Tag/autoescape.pm
Criterion Covered Total %
statement 82 91 90.1
branch 11 18 61.1
condition n/a
subroutine 12 14 85.7
pod 11 11 100.0
total 116 134 86.5


line stmt bran cond sub pod time code
1             #autoescape.pm
2             #Last Change: 2009-01-19
3             #Copyright (c) 2009 Marc-Seabstian "Maluku" Lucksch
4             #Version 0.8
5             ####################
6             #This file is part of the Dotiac::DTL project.
7             #http://search.cpan.org/perldoc?Dotiac::DTL
8             #
9             #autoescape.pm is published under the terms of the MIT license, which basically
10             #means "Do with it whatever you want". For more information, see the
11             #license.txt file that should be enclosed with libsofu distributions. A copy of
12             #the license is (at the time of writing) also available at
13             #http://www.opensource.org/licenses/mit-license.php .
14             ###############################################################################
15            
16            
17            
18             package Dotiac::DTL::Tag::autoescape;
19 11     11   63 use base qw/Dotiac::DTL::Tag/;
  11         31  
  11         779  
20 11     11   52 use strict;
  11         61  
  11         296  
21 11     11   52 use warnings;
  11         17  
  11         10363  
22            
23             our $VERSION = 0.8;
24            
25             sub new {
26 4     4 1 6 my $class=shift;
27 4         12 my $self={p=>shift()};
28 4         9 my $name=shift;
29 4         5 my $obj=shift;
30 4         6 my $data=shift;
31 4         6 my $pos=shift;
32 4         7 my $found="";
33 4 50       9 $name="" unless $name;
34 4         26 $self->{content}=$obj->parse($data,$pos,\$found,"endautoescape");
35 4 100       18 $self->{escape}=0 if $name =~ /off/i;
36 4 100       18 $self->{escape}=1 if $name =~ /on/i;
37 4         12 bless $self,$class;
38 4         11 return $self;
39             }
40             sub print {
41 4     4 1 6 my $self=shift;
42 4         20 print $self->{p};
43 4         7 my $vars=shift;
44 4         9 my $escape=shift;
45 4 50       14 if (defined $self->{escape}) {
46 4         23 $self->{content}->print($vars,$self->{escape},@_);
47             }
48             else {
49 0         0 $self->{content}->print($vars,$escape,@_);
50             }
51 4         17 $self->{n}->print($vars,$escape,@_);
52             }
53             sub string {
54 4     4 1 6 my $self=shift;
55 4         7 my $vars=shift;
56 4         5 my $escape=shift;
57 4         9 my $r="";
58 4 50       12 if (defined $self->{escape}) {
59 4         24 $r=$self->{content}->string($vars,$self->{escape},@_);
60             }
61             else {
62 0         0 $r=$self->{content}->string($vars,$escape,@_);
63             }
64 4         25 return $self->{p}.$r.$self->{n}->string($vars,$escape,@_);
65            
66             }
67             sub perl {
68 4     4 1 8 my $self=shift;
69 4         6 my $fh=shift;
70 4         6 my $id=shift;
71 4         33 $self->SUPER::perl($fh,$id,@_);
72 4         31 $id = $self->{content}->perl($fh,$id+1,@_);
73 4         19 return $self->{n}->perl($fh,$id+1,@_)
74             }
75             sub perlinit {
76 4     4 1 9 my $self=shift;
77 4         7 my $fh=shift;
78 4         6 my $id=shift;
79 4         21 $id = $self->{content}->perlinit($fh,$id+1,@_);
80 4         15 return $self->{n}->perlinit($fh,$id+1,@_)
81             }
82             sub perlprint {
83 4     4 1 9 my $self=shift;
84 4         4 my $fh=shift;
85 4         7 my $id=shift;
86 4         5 my $level=shift;
87 4         29 $self->SUPER::perlprint($fh,$id,$level,@_);
88 4 50       16 if (defined $self->{escape}) {
89 4         9 print $fh "\t" x $level,"{\n";
90 4         7 $level++;
91 4         19 print $fh "\t" x $level,"my \$escape=",$self->{escape},";\n";
92             }
93 4         32 $id = $self->{content}->perlprint($fh,$id+1,$level,@_);
94 4 50       19 if (defined $self->{escape}) {
95 4         7 $level--;
96 4         10 print $fh "\t" x $level,"}\n";
97            
98             }
99 4         28 return $self->{n}->perlprint($fh,$id+1,$level,@_);
100             }
101             sub perlstring {
102 4     4 1 8 my $self=shift;
103 4         7 my $fh=shift;
104 4         7 my $id=shift;
105 4         7 my $level=shift;
106 4         21 $self->SUPER::perlstring($fh,$id,$level,@_);
107 4 50       14 if (defined $self->{escape}) {
108 4         10 print $fh "\t" x $level,"{\n";
109 4         8 $level++;
110 4         24 print $fh "\t" x $level,"my \$escape=",$self->{escape},";\n";
111             }
112 4         29 $id = $self->{content}->perlstring($fh,$id+1,$level,@_);
113 4 50       17 if (defined $self->{escape}) {
114 4         5 $level--;
115 4         12 print $fh "\t" x $level,"}\n";
116            
117             }
118 4         16 return $self->{n}->perlstring($fh,$id+1,$level,@_);
119             }
120             sub perleval {
121 4     4 1 7 my $self=shift;
122 4         5 my $fh=shift;
123 4         6 my $id=shift;
124 4         20 $id=$self->{content}->perleval($fh,$id+1,@_);
125 4         19 $self->{n}->perleval($fh,$id+1,@_);
126             }
127             sub perlcount {
128 0     0 1 0 my $self=shift;
129 0         0 my $id=shift;
130 0         0 $id=$self->{content}->perlcount($id+1,@_);
131 0         0 return $self->{n}->perlcount($id+1);
132             }
133             sub next {
134 4     4 1 8 my $self=shift;
135 4         15 $self->{n}=shift;
136             }
137             sub eval {
138 0     0 1   my $self=shift;
139 0           $self->{content}->eval(@_);
140 0           $self->{n}->eval(@_);
141             }
142             1;
143            
144             __END__