File Coverage

blib/lib/Dotiac/DTL/Tag/with.pm
Criterion Covered Total %
statement 101 114 88.6
branch 10 22 45.4
condition 10 33 30.3
subroutine 12 14 85.7
pod 11 11 100.0
total 144 194 74.2


line stmt bran cond sub pod time code
1             #with.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             #with.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             package Dotiac::DTL::Tag::with;
17 11     11   61 use base qw/Dotiac::DTL::Tag/;
  11         30  
  11         934  
18 11     11   62 use strict;
  11         21  
  11         359  
19 11     11   66 use warnings;
  11         28  
  11         31758  
20             our $VERSION = 0.8;
21            
22             sub new {
23 3     3 1 6 my $class=shift;
24 3         10 my $self={p=>shift()};
25 3         6 my $name=shift;
26 3         14 my %name=Dotiac::DTL::get_variables($name,"as");
27 3 50 33     14 die "Can't use tag 'with' without a variable" unless $name{""} and @{$name{""}};
  3         14  
28 3 50 33     11 die "Can't use tag 'with' without a new variable name (as)" unless $name{as} and @{$name{as}};
  3         12  
29 3         10 $self->{var}=$name{""}->[0];
30 3         7 $self->{as}=$name{as}->[0];
31 3         4 my $obj=shift;
32 3         6 my $data=shift;
33 3         6 my $pos=shift;
34 3         4 my $found="";
35 3         14 $self->{content}=$obj->parse($data,$pos,\$found,"endwith");
36 3         12 bless $self,$class;
37 3         17 return $self;
38             }
39             sub print {
40 3     3 1 6 my $self=shift;
41 3         5 print $self->{p};
42 3         6 my $vars=shift;
43 3 50 33     21 if (defined $self->{var} and $self->{as} ) {
44 3         15 $self->{content}->print({%{$vars},$self->{as}=>Dotiac::DTL::devar($self->{var},$vars,@_)},@_);
  3         15  
45             }
46             else {
47 0         0 $self->{content}->print($vars,@_);
48             }
49 3         21 $self->{n}->print($vars,@_);
50             }
51             sub string {
52 3     3 1 5 my $self=shift;
53 3         4 my $vars=shift;
54 3 50 33     20 return $self->{p}.$self->{content}->string({%{$vars},$self->{as}=>Dotiac::DTL::devar($self->{var},$vars,@_)},@_).$self->{n}->string($vars,@_) if $self->{var} and $self->{as};
  3         16  
55 0         0 return $self->{p}.$self->{content}->string($vars,@_).$self->{n}->string($vars,@_);
56            
57             }
58             sub perl {
59 3     3 1 5 my $self=shift;
60 3         5 my $fh=shift;
61 3         3 my $id=shift;
62 3         15 $self->SUPER::perl($fh,$id,@_);
63 3         5 print $fh "my ";
64 3         18 print $fh (Data::Dumper->Dump([$self->{var}],["\$var$id"]));
65 3         106 print $fh "my ";
66 3         14 print $fh (Data::Dumper->Dump([$self->{as}],["\$as$id"]));
67 3         519 $id = $self->{content}->perl($fh,$id+1,@_);
68 3         17 return $self->{n}->perl($fh,$id+1,@_)
69             }
70             sub perlinit {
71 3     3 1 5 my $self=shift;
72 3         5 my $fh=shift;
73 3         5 my $id=shift;
74 3         13 $id = $self->{content}->perlinit($fh,$id+1,@_);
75 3         11 return $self->{n}->perlinit($fh,$id+1,@_)
76             }
77             sub perlprint {
78 3     3 1 4 my $self=shift;
79 3         5 my $fh=shift;
80 3         5 my $id=shift;
81 3         4 my $level=shift;
82 3         15 $self->SUPER::perlprint($fh,$id,$level,@_);
83 3 50 33     24 if (defined $self->{var} and $self->{as} ) {
84 3         9 print $fh "\t" x $level,"my \$vars$id=\$vars;\n";
85 3         8 print $fh "\t" x $level,"{\n";
86 3         4 $level++;
87 3         10 print $fh "\t" x $level,"my \$vars={\%{\$vars$id}};\n";
88 3         9 print $fh "\t" x $level,"\$vars->{\$as$id}=Dotiac::DTL::devar(\$var$id,\$vars,\$escape,\@_);\n";
89            
90             }
91 3         13 $id = $self->{content}->perlprint($fh,$id+1,$level,@_);
92 3 50 33     25 if (defined $self->{var} and $self->{as}) {
93 3         3 $level--;
94 3         9 print $fh "\t" x $level,"}\n";
95            
96             }
97 3         13 return $self->{n}->perlprint($fh,$id+1,$level,@_);
98             }
99             sub perlstring {
100 3     3 1 6 my $self=shift;
101 3         4 my $fh=shift;
102 3         4 my $id=shift;
103 3         6 my $level=shift;
104 3         17 $self->SUPER::perlstring($fh,$id,$level,@_);
105 3 50 33     21 if (defined $self->{var} and $self->{as} ) {
106 3         9 print $fh "\t" x $level,"my \$vars$id=\$vars;\n";
107 3         23 print $fh "\t" x $level,"{\n";
108 3         6 $level++;
109 3         9 print $fh "\t" x $level,"my \$vars={\%{\$vars$id}};\n";
110 3         9 print $fh "\t" x $level,"\$vars->{\$as$id}=Dotiac::DTL::devar(\$var$id,\$vars,\$escape,\@_);\n";
111            
112             }
113 3         14 $id = $self->{content}->perlstring($fh,$id+1,$level,@_);
114 3 50 33     22 if (defined $self->{var} and $self->{as}) {
115 3         4 $level--;
116 3         8 print $fh "\t" x $level,"}\n";
117            
118             }
119 3         13 return $self->{n}->perlstring($fh,$id+1,$level,@_);
120             }
121             sub perleval {
122 3     3 1 6 my $self=shift;
123 3         4 my $fh=shift;
124 3         5 my $id=shift;
125 3         3 my $level=shift;
126 3 50 33     15 if (defined $self->{var} and $self->{as} ) {
127 3         11 print $fh "\t" x $level,"my \$vars$id=\$vars;\n";
128 3         7 print $fh "\t" x $level,"{\n";
129 3         7 $level++;
130 3         7 print $fh "\t" x $level,"my \$vars={\%{\$vars$id}};\n";
131 3         9 print $fh "\t" x $level,"\$vars->{\$as$id}=Dotiac::DTL::devar(\$var$id,\$vars,\$escape,\@_);\n";
132            
133             }
134 3         20 $id=$self->{content}->perleval($fh,$id+1,$level,@_);
135 3 50 33     15 if (defined $self->{var} and $self->{as}) {
136 3         4 $level--;
137 3         8 print $fh "\t" x $level,"}\n";
138            
139             }
140 3         19 $self->{n}->perleval($fh,$id+1,$level,@_);
141             }
142             sub perlcount {
143 0     0 1 0 my $self=shift;
144 0         0 my $id=shift;
145 0         0 $id=$self->{content}->perlcount($id+1,@_);
146 0         0 return $self->{n}->perlcount($id+1);
147             }
148             sub next {
149 3     3 1 6 my $self=shift;
150 3         20 $self->{n}=shift;
151             }
152             sub eval {
153 0     0 1   my $self=shift;
154 0           my $vars=shift;
155 0 0 0       if (defined $self->{var} and $self->{as} ) {
156 0           $self->{content}->eval({%{$vars},$self->{as}=>Dotiac::DTL::devar($self->{var},$vars,@_)},@_);
  0            
157             }
158             else {
159 0           $self->{content}->eval($vars,@_);
160             }
161 0           $self->{n}->eval($vars,@_);
162             }
163            
164             1;
165             __END__