File Coverage

blib/lib/Dotiac/DTL/Tag/firstof.pm
Criterion Covered Total %
statement 64 70 91.4
branch 5 6 83.3
condition 1 2 50.0
subroutine 12 14 85.7
pod 11 11 100.0
total 93 103 90.2


line stmt bran cond sub pod time code
1             #firstof.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             #firstof.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::firstof;
17 11     11   62 use base qw/Dotiac::DTL::Tag/;
  11         31  
  11         947  
18 11     11   58 use strict;
  11         21  
  11         356  
19 11     11   68 use warnings;
  11         25  
  11         9811  
20            
21             our $VERSION = 0.8;
22            
23             sub new {
24 4     4 1 7 my $class=shift;
25 4         11 my $self={p=>shift()};
26 4         18 $self->{vars}=[Dotiac::DTL::get_variables(shift())];
27 4         13 bless $self,$class;
28 4         12 return $self;
29             }
30             sub print {
31 4     4 1 7 my $self=shift;
32 4         17 print $self->{p};
33 4         6 foreach my $v (@{$self->{vars}}) {
  4         11  
34 10         29 my $r = Dotiac::DTL::devar($v,@_);
35 10 100 50     32 print $r and last if $r;
36             }
37 4         21 $self->{n}->print(@_);
38             }
39             sub string {
40 4     4 1 6 my $self=shift;foreach my $v (@{$self->{vars}}) {
  4         8  
  4         11  
41 10         31 my $r = Dotiac::DTL::devar($v,@_);
42 10 100       55 return $self->{p}.$r.$self->{n}->string(@_) if $r;
43             }
44 1         8 return $self->{p}.$self->{n}->string(@_);
45             }
46             sub perl {
47 4     4 1 7 my $self=shift;
48 4         6 my $fh=shift;
49 4         5 my $id=shift;
50 4         20 $self->SUPER::perl($fh,$id,@_);
51 4         6 print $fh "my ";
52 4         24 print $fh (Data::Dumper->Dump([$self->{vars}],["\$vars$id"]));
53 4 50       246 return $self->{n}->perl($fh,$id+1,@_) if $self->{n};
54 0         0 return $id;
55             }
56             sub perlprint {
57 4     4 1 7 my $self=shift;
58 4         5 my $fh=shift;
59 4         5 my $id=shift;
60 4         3 my $level=shift;
61 4         18 $self->SUPER::perlprint($fh,$id,$level,@_);
62 4         7 my $in="\t" x $level;
63 4         7 print $fh $in,"print ",join(" || ",map {"Dotiac::DTL::devar(\$vars$id"."->[$_],\$vars,\$escape,\@_)"} (0 .. $#{$self->{vars}})),";\n";
  11         41  
  4         9  
64 4         29 return $self->{n}->perlprint($fh,$id+1,$level,@_);
65             }
66             sub perlstring {
67 4     4 1 5 my $self=shift;
68 4         6 my $fh=shift;
69 4         5 my $id=shift;
70 4         4 my $level=shift;
71 4         20 $self->SUPER::perlstring($fh,$id,$level,@_);
72 4         10 my $in="\t" x $level;
73 4         6 print $fh $in,"\$r.=",join(" || ",map {"Dotiac::DTL::devar(\$vars$id"."->[$_],\$vars,\$escape,\@_)"} (0 .. $#{$self->{vars}})),";\n";
  11         43  
  4         12  
74 4         32 return $self->{n}->perlstring($fh,$id+1,$level,@_);
75             }
76             sub perlcount {
77 0     0 1 0 my $self=shift;
78 0         0 my $id=shift;
79 0         0 return $self->{n}->perlcount($id+1);
80             }
81             sub perleval {
82 4     4 1 5 my $self=shift;
83 4         6 my $fh=shift;
84 4         6 my $id=shift;
85 4         25 return $self->{n}->perleval($fh,$id+1,@_);
86             }
87             sub perlinit {
88 4     4 1 6 my $self=shift;
89 4         6 my $fh=shift;
90 4         5 my $id=shift;
91 4         17 return $self->{n}->perlinit($fh,$id+1,@_);
92             }
93             sub next {
94 4     4 1 5 my $self=shift;
95 4         21 $self->{n}=shift;
96             }
97             sub eval {
98 0     0 1   my $self=shift;
99 0           $self->{n}->eval(@_);
100             }
101             1;
102            
103             __END__