File Coverage

blib/lib/Dotiac/DTL/Tag/spaceless.pm
Criterion Covered Total %
statement 75 82 91.4
branch 1 2 50.0
condition n/a
subroutine 12 14 85.7
pod 11 11 100.0
total 99 109 90.8


line stmt bran cond sub pod time code
1             #spaceless.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             #spaceless.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::spaceless;
17 11     11   61 use base qw/Dotiac::DTL::Tag/;
  11         23  
  11         1044  
18 11     11   61 use strict;
  11         30  
  11         366  
19 11     11   60 use warnings;
  11         23  
  11         19940  
20            
21             our $VERSION = 0.8;
22            
23             #This is not optimized during print.
24             sub new {
25 1     1 1 3 my $class=shift;
26 1         5 my $self={p=>shift()};
27 1         2 my $name=shift;
28 1         3 my $obj=shift;
29 1         3 my $data=shift;
30 1         2 my $pos=shift;
31 1         2 my $found="";
32 1         7 $self->{content}=$obj->parse($data,$pos,\$found,"endspaceless");
33 1         4 bless $self,$class;
34 1         6 return $self;
35             }
36             sub print {
37 1     1 1 3 my $self=shift;
38 1         4 print $self->{p};
39 1         8 my $r=$self->{content}->string(@_);
40 1         14 $r=~s/>\s+
41 1         14 print $r;
42 1         8 $self->{n}->print(@_);
43             }
44             sub string {
45 1     1 1 4 my $self=shift;
46 1         8 my $r=$self->{content}->string(@_);
47 1         13 $r=~s/>\s+
48 1         6 return $self->{p}.$r.$self->{n}->string(@_);
49            
50             }
51             sub perl {
52 1     1 1 3 my $self=shift;
53 1         3 my $fh=shift;
54 1         3 my $id=shift;
55 1         13 $self->SUPER::perl($fh,$id,@_);
56 1         7 $id=$self->{content}->perl($fh,$id+1,@_);
57 1 50       9 return $self->{n}->perl($fh,$id+1,@_) if $self->{n};
58 0         0 return $id;
59             }
60             sub perlprint {
61 1     1 1 4 my $self=shift;
62 1         2 my $fh=shift;
63 1         3 my $id=shift;
64 1         2 my $level=shift;
65 1         23 $self->SUPER::perlprint($fh,$id,$level,@_);
66 1         3 my $in="\t" x $level;
67 1         2 print $fh $in,"{\n";
68 1         3 print $fh $in,"\tmy \$r=\"\";\n";
69 1         7 my $nid = $self->{content}->perlstring($fh,$id+1,$level+1,@_);
70 1         4 print $fh $in,"\t\$r=~s/>\\s+
71 1         4 print $fh $in,"\tprint \$r;\n";
72 1         3 print $fh $in,"}\n";
73 1         6 return $self->{n}->perlprint($fh,$nid+1,$level,@_);
74             }
75             sub perlstring {
76 1     1 1 3 my $self=shift;
77 1         2 my $fh=shift;
78 1         3 my $id=shift;
79 1         2 my $level=shift;
80 1         9 $self->SUPER::perlstring($fh,$id,$level,@_);
81 1         3 my $in="\t" x $level;
82 1         4 print $fh $in,"my \$v$id=\"\";\n";
83 1         3 print $fh $in,"{\n";
84 1         2 print $fh $in,"\tmy \$r=\"\";\n";
85 1         7 my $nid = $self->{content}->perlstring($fh,$id+1,$level+1,@_);
86 1         3 print $fh $in,"\t\$r=~s/>\\s+
87 1         3 print $fh $in,"\t\$v$id=\$r;\n";
88 1         3 print $fh $in,"}\n";
89 1         3 print $fh $in,"\$r.=\$v$id;\n";
90 1         6 return $self->{n}->perlstring($fh,$nid+1,$level,@_);
91             }
92             sub perlcount {
93 0     0 1 0 my $self=shift;
94 0         0 my $id=shift;
95 0         0 $id = $self->{content}->perlcount($id+1);
96 0         0 return $self->{n}->perlcount($id+1);
97             }
98             sub perleval {
99 1     1 1 4 my $self=shift;
100 1         2 my $fh=shift;
101 1         3 my $id=shift;
102 1         7 $id=$self->{content}->perleval($fh,$id+1,@_);
103 1         8 return $self->{n}->perleval($fh,$id+1,@_);
104             }
105             sub perlinit {
106 1     1 1 3 my $self=shift;
107 1         3 my $fh=shift;
108 1         2 my $id=shift;
109 1         6 $id=$self->{content}->perlinit($fh,$id+1,@_);
110 1         6 return $self->{n}->perlinit($fh,$id+1,@_);
111             }
112             sub next {
113 1     1 1 3 my $self=shift;
114 1         17 $self->{n}=shift;
115             }
116             sub eval {
117 0     0 1   my $self=shift;
118 0           $self->{n}->eval(@_);
119             }
120             1;
121            
122             __END__