File Coverage

blib/lib/Dotiac/DTL/Tag/templatetag.pm
Criterion Covered Total %
statement 50 56 89.2
branch 2 4 50.0
condition n/a
subroutine 12 14 85.7
pod 11 11 100.0
total 75 85 88.2


line stmt bran cond sub pod time code
1             #templatetag.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             #templatetag.pm is published under the terms of the MIT license, which
10             #basically 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             package Dotiac::DTL::Tag::templatetag;
18 11     11   59 use base qw/Dotiac::DTL::Tag/;
  11         22  
  11         1003  
19 11     11   70 use strict;
  11         18  
  11         345  
20 11     11   54 use warnings;
  11         19  
  11         14891  
21            
22             our $VERSION = 0.8;
23            
24             my %tags=(
25             openblock=>"{%",
26             closeblock=>"%}",
27             openvariable=>"{{",
28             closevariable=>"}}",
29             openbrace=>"{",
30             closebrace=>"}",
31             opencomment=>"{#",
32             closecomment=>"#}"
33             );
34            
35             sub new {
36 8     8 1 11 my $class=shift;
37 8         19 my $self={p=>shift()};
38 8         19 bless $self,$class;
39 8         11 my $name=shift;
40 8 50       19 die "Unknown templatetag \"\"" unless $tags{$name};
41 8         28 $self->{out}=$tags{$name};
42 8         18 return $self;
43             }
44             sub print {
45 8     8 1 12 my $self=shift;
46 8         35 print $self->{p},$self->{out};
47 8         35 $self->{n}->print(@_);
48             }
49             sub string {
50 8     8 1 13 my $self=shift;
51 8         68 return $self->{p}.$self->{out}.$self->{n}->string(@_);
52            
53             }
54             sub perl {
55 8     8 1 12 my $self=shift;
56 8         8 my $fh=shift;
57 8         23 my $id=shift;
58 8         28 $self->SUPER::perl($fh,$id,@_);
59 8 50       44 return $self->{n}->perl($fh,$id+1,@_) if $self->{n};
60 0         0 return $id;
61             }
62             sub perlprint {
63 8     8 1 11 my $self=shift;
64 8         9 my $fh=shift;
65 8         10 my $id=shift;
66 8         10 my $level=shift;
67 8         25 $self->SUPER::perlprint($fh,$id,$level,@_);
68 8         24 print $fh "\t" x $level,"print \"$self->{out}\";\n";
69 8         34 return $self->{n}->perlprint($fh,$id+1,$level,@_);
70             }
71             sub perlstring {
72 8     8 1 13 my $self=shift;
73 8         9 my $fh=shift;
74 8         11 my $id=shift;
75 8         8 my $level=shift;
76 8         29 $self->SUPER::perlstring($fh,$id,$level,@_);
77 8         22 print $fh "\t" x $level,"\$r.=\"$self->{out}\";\n";
78 8         44 return $self->{n}->perlstring($fh,$id+1,$level,@_);
79             }
80             sub perlcount {
81 0     0 1 0 my $self=shift;
82 0         0 my $id=shift;
83 0         0 return $self->{n}->perlcount($id+1);
84             }
85             sub perleval {
86 8     8 1 12 my $self=shift;
87 8         11 my $fh=shift;
88 8         11 my $id=shift;
89 8         33 return $self->{n}->perleval($fh,$id+1,@_);
90             }
91             sub perlinit {
92 8     8 1 11 my $self=shift;
93 8         9 my $fh=shift;
94 8         10 my $id=shift;
95 8         24 return $self->{n}->perlinit($fh,$id+1,@_);
96             }
97             sub next {
98 8     8 1 10 my $self=shift;
99 8         19 $self->{n}=shift;
100             }
101             sub eval {
102 0     0 1   my $self=shift;
103 0           $self->{n}->eval(@_);
104             }
105             1;
106            
107             __END__