File Coverage

lib/Petal/Parser.pm
Criterion Covered Total %
statement 139 140 99.2
branch 42 48 87.5
condition 1 3 33.3
subroutine 15 16 93.7
pod 0 8 0.0
total 197 215 91.6


line stmt bran cond sub pod time code
1             # ------------------------------------------------------------------
2             # Petal::Parser - Fires Petal::Canonicalizer events
3             # ------------------------------------------------------------------
4             # A Wrapper class for MKDoc::XML:TreeBuilder which is meant to be
5             # used for Petal::Canonicalizer.
6             # ------------------------------------------------------------------
7             package Petal::Parser;
8 77     77   35847 use MKDoc::XML::TreeBuilder;
  77         229425  
  77         1691  
9 77     77   29633 use MKDoc::XML::Decode;
  77         256678  
  77         1816  
10 77     77   329 use strict;
  77         94  
  77         1088  
11 77     77   215 use warnings;
  77         76  
  77         1259  
12 77     77   228 use Carp;
  77         71  
  77         3754  
13              
14 77     77   22457 use Petal::Canonicalizer::XML;
  77         110  
  77         2017  
15 77     77   21326 use Petal::Canonicalizer::XHTML;
  77         118  
  77         2102  
16              
17 77         79418 use vars qw /@NodeStack @MarkedData $Canonicalizer
18 77     77   338 @NameSpaces @XI_NameSpaces @MT_NameSpaces @MT_Name_Cur $Decode/;
  77         80  
19              
20              
21             # this avoid silly warnings
22             sub sillyness
23             {
24 0     0 0 0 $Petal::NS,
25             $Petal::NS_URI,
26             $Petal::XI_NS_URI;
27             }
28              
29              
30             sub new
31             {
32 206     206 0 237 my $class = shift;
33 206   33     796 $class = ref $class || $class;
34 206         428 return bless { @_ }, $class;
35             }
36              
37              
38             sub process
39             {
40 206     206 0 233 my $self = shift;
41 206         278 local $Canonicalizer = shift;
42 206         208 my $data_ref = shift;
43            
44 206         520 local @MarkedData = ();
45 206         525 local @NodeStack = ();
46 206         273 local @NameSpaces = ();
47 206         284 local @MT_NameSpaces = ();
48 206         411 local @MT_Name_Cur = ('main');
49 206         470 local $Decode = new MKDoc::XML::Decode (qw /xml numeric/);
50            
51 206 50       1784 $data_ref = (ref $data_ref) ? $data_ref : \$data_ref;
52            
53 206         931 my @top_nodes = MKDoc::XML::TreeBuilder->process_data ($$data_ref);
54 202         641380 for (@top_nodes) { $self->generate_events ($_) }
  234         3136  
55            
56 202         291 @MarkedData = ();
57 202         2544 @NodeStack = ();
58             }
59              
60              
61             # generate_events();
62             # ------------------
63             # Once the HTML::TreeBuilder object is built and elementified, it is
64             # passed to that subroutine which will traverse it and will trigger
65             # proper subroutines which will generate the XML events which are used
66             # by the Petal::Canonicalizer module
67             sub generate_events
68             {
69 3687     3687 0 2837 my $self = shift;
70 3687         2975 my $tree = shift;
71            
72 3687 100       4705 if (ref $tree)
73             {
74 1484         1874 my $tag = $tree->{_tag};
75 1484 100       1153 my $attr = { map { /^_/ ? () : ( $_ => $Decode->process ($tree->{$_}) ) } keys %{$tree} };
  7897         26023  
  1484         3719  
76            
77 1484 100       5757 if ($tag eq '~comment')
78             {
79 13         26 generate_events_comment ($tree->{text});
80             }
81             else
82             {
83             # decode attributes
84 1471         1086 for (keys %{$tree})
  1471         2869  
85             {
86 7871 100       25093 $tree->{$_} = $Decode->process ( $tree->{$_} )
87             unless (/^_/);
88             }
89            
90 1471         4450 push @NodeStack, $tree;
91 1471         1792 generate_events_start ($tag, $attr);
92            
93 1471         1261 foreach my $content (@{$tree->{_content}})
  1471         2836  
94             {
95 3453         4952 $self->generate_events ($content);
96             }
97            
98 1471         1956 generate_events_end ($tag);
99 1471         3042 pop (@NodeStack);
100             }
101             }
102             else
103             {
104 2203         3913 $tree = $Decode->process ( $tree );
105 2203         15894 generate_events_text ($tree);
106             }
107             }
108              
109              
110             sub generate_events_start
111             {
112 1471     1471 0 1414 local $_ = shift;
113 1471         1977 $_ = "<$_>";
114 1471         1130 local %_ = %{shift()};
  1471         4228  
115 1471         1496 delete $_{'/'};
116            
117             # process the Petal namespace
118 1471 100       2302 my $ns = (scalar @NameSpaces) ? $NameSpaces[$#NameSpaces] : $Petal::NS;
119 1471         2590 foreach my $key (keys %_)
120             {
121 2422         2208 my $value = $_{$key};
122 2422 100       3815 if ($value eq $Petal::NS_URI)
123             {
124 55 50       166 next unless ($key =~ /^xmlns\:/);
125 55         99 delete $_{$key};
126 55         67 $ns = $key;
127 55         173 $ns =~ s/^xmlns\://;
128             }
129             }
130            
131 1471         1566 push @NameSpaces, $ns;
132 1471         1333 local ($Petal::NS) = $ns;
133            
134             # process the XInclude namespace
135 1471 100       1959 my $xi_ns = (scalar @XI_NameSpaces) ? $XI_NameSpaces[$#XI_NameSpaces] : $Petal::XI_NS;
136 1471         1929 foreach my $key (keys %_)
137             {
138 2367         2100 my $value = $_{$key};
139 2367 100       3238 if ($value eq $Petal::XI_NS_URI)
140             {
141 39 50       86 next unless ($key =~ /^xmlns\:/);
142 39         44 delete $_{$key};
143 39         34 $xi_ns = $key;
144 39         99 $xi_ns =~ s/^xmlns\://;
145             }
146             }
147            
148 1471         1407 push @XI_NameSpaces, $xi_ns;
149 1471         1243 local ($Petal::XI_NS) = $xi_ns;
150            
151             # process the Metal namespace
152 1471 100       1964 my $mt_ns = (scalar @MT_NameSpaces) ? $MT_NameSpaces[$#MT_NameSpaces] : $Petal::MT_NS;
153 1471         1740 foreach my $key (keys %_)
154             {
155 2328         2004 my $value = $_{$key};
156 2328 100       3209 if ($value eq $Petal::MT_NS_URI)
157             {
158 10 50       55 next unless ($key =~ /^xmlns\:/);
159 10         13 delete $_{$key};
160 10         10 $mt_ns = $key;
161 10         38 $mt_ns =~ s/^xmlns\://;
162             }
163             }
164            
165 1471         1375 push @MT_NameSpaces, $mt_ns;
166 1471         1211 local ($Petal::MT_NS) = $mt_ns;
167              
168             # process the Metal current name
169 1471         1068 my $pushed = 0;
170              
171 1471 100       2796 $_{"$mt_ns:define-macro"} and do {
172 44         29 $pushed = 1;
173 44         52 delete $_{"$mt_ns:define-slot"};
174 44         76 push @MT_Name_Cur, delete $_{"$mt_ns:define-macro"};
175             };
176            
177 1471 100       2275 $_{"$mt_ns:fill-slot"} and do {
178 8         8 $pushed = 1;
179 8         22 push @MT_Name_Cur, "__metal_slot__" . delete $_{"$mt_ns:fill-slot"};
180             };
181              
182 1471 100       2588 push @MT_Name_Cur, $MT_Name_Cur[$#MT_Name_Cur] unless ($pushed);
183              
184 1471         9126 my $dont_skip = grep /^\Q$Petal::MT_NAME_CUR\E$/, @MT_Name_Cur;
185 1471 100       4752 $Canonicalizer->StartTag() if ($dont_skip);
186             }
187              
188              
189             sub generate_events_end
190             {
191 1471     1471 0 1542 local $_ = shift;
192 1471         2076 local $_ = "";
193 1471         1756 local ($Petal::NS) = pop (@NameSpaces);
194 1471         1265 local ($Petal::XI_NS) = pop (@XI_NameSpaces);
195 1471         1244 local ($Petal::MT_NS) = pop (@MT_NameSpaces);
196            
197 1471         1180 my $skip = 1;
198 1471 100       1492 for (@MT_Name_Cur) { $_ eq $Petal::MT_NAME_CUR and $skip = 0 }
  6607         8466  
199              
200 1471         8562 my $dont_skip = grep /^\Q$Petal::MT_NAME_CUR\E$/, @MT_Name_Cur;
201 1471 100       3952 $Canonicalizer->EndTag() if ($dont_skip);
202 1471         1938 pop (@MT_Name_Cur);
203             }
204              
205              
206             sub generate_events_text
207             {
208              
209 2203     2203 0 1700 my $skip = 1;
210 2203 100       2576 for (@MT_Name_Cur) { $_ eq $Petal::MT_NAME_CUR and $skip = 0 }
  9190         12337  
211            
212 2203         1768 my $data = shift;
213 2203         2114 $data =~ s/\&/&/g;
214 2203         1703 $data =~ s/\
215 2203         1880 local $_ = $data;
216 2203         2960 local ($Petal::NS) = $NameSpaces[$#NameSpaces];
217 2203         2238 local ($Petal::XI_NS) = $XI_NameSpaces[$#XI_NameSpaces];
218 2203         2332 local ($Petal::MT_NS) = $MT_NameSpaces[$#MT_NameSpaces];
219              
220 2203         12483 my $dont_skip = grep /^\Q$Petal::MT_NAME_CUR\E$/, @MT_Name_Cur;
221 2203 100       5944 $Canonicalizer->Text() if ($dont_skip);
222             }
223              
224              
225             sub generate_events_comment
226             {
227 13     13 0 22 my $skip = 1;
228 13 50       21 for (@MT_Name_Cur) { $_ eq $Petal::MT_NAME_CUR and $skip = 0 }
  33         61  
229            
230 13         16 my $data = shift;
231 13         30 local $_ = '';
232            
233 13         107 my $dont_skip = grep /^\Q$Petal::MT_NAME_CUR\E$/, @MT_Name_Cur;
234 13 50       47 $Canonicalizer->Text() if ($dont_skip);
235             }
236              
237              
238             1;
239              
240              
241             __END__