File Coverage

lib/XML/DOM/Lite/XSLT.pm
Criterion Covered Total %
statement 141 308 45.7
branch 63 178 35.3
condition 22 68 32.3
subroutine 22 28 78.5
pod 0 21 0.0
total 248 603 41.1


line stmt bran cond sub pod time code
1             package XML::DOM::Lite::XSLT;
2 7     7   43 use warnings;
  7         14  
  7         205  
3 7     7   35 use strict;
  7         11  
  7         120  
4              
5 7     7   33 use XML::DOM::Lite::XPath;
  7         13  
  7         157  
6 7     7   27 use XML::DOM::Lite::Constants qw(:all);
  7         12  
  7         950  
7 7     7   41 use Carp qw(confess);
  7         11  
  7         262  
8              
9 7     7   33 use warnings;
  7         11  
  7         161  
10 7     7   28 use strict;
  7         12  
  7         20220  
11              
12             our $DEBUG = 0;
13              
14 0     0 0 0 sub new { bless { }, $_[0] }
15              
16             sub process {
17 1     1 0 302 my ($self, $xmlDoc, $stylesheet) = @_;
18 1         3 return xsltProcess($xmlDoc, $stylesheet);
19             }
20              
21             sub xsltProcess {
22 1     1 0 3 my ($xmlDoc, $stylesheet) = @_;
23              
24 1 50       8 $DEBUG && warn('XML STYLESHEET:');
25 1 50       2 $DEBUG && warn(xmlText($stylesheet));
26 1 50       3 $DEBUG && warn('XML INPUT:');
27 1 50       7 $DEBUG && warn(xmlText($xmlDoc));
28              
29 1         5 my $output = $xmlDoc->createDocumentFragment();
30 1         8 xsltProcessContext(XML::DOM::Lite::XPath::ExprContext->new($xmlDoc), $stylesheet, $output);
31              
32 1         3 my $ret = xmlText($output);
33              
34 1 50       4 $DEBUG && warn('HTML OUTPUT:');
35 1 50       3 $DEBUG && warn($ret);
36              
37 1         12 return $ret;
38             }
39              
40             sub xsltProcessContext {
41 10     10 0 19 my ($input, $template, $output) = @_;
42 10         23 my @nodename = split(/:/, $template->nodeName);
43 10 100 66     41 if (@nodename == 1 or $nodename[0] ne 'xsl') {
44 2         14 xsltPassThrough($input, $template, $output);
45              
46             } else {
47 8 50 66     116 if ($nodename[1] eq 'apply-imports') {
    100          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    100          
    100          
    50          
    50          
    0          
    0          
    0          
    0          
48 0         0 warn('not implemented: ' . $nodename[1]);
49             } elsif ($nodename[1] eq 'apply-templates') {
50 2         4 my $select = xmlGetAttribute($template, 'select');
51 2         3 my $nodes;
52 2 50       5 if ($select) {
53 2         5 $nodes = xpathEval($select, $input)->nodeSetValue();
54             } else {
55 0         0 $nodes = $input->{node}->childNodes;
56             }
57              
58 2         6 my $sortContext = $input->clone($nodes->[0], 0, $nodes);
59 2         6 xsltWithParam($sortContext, $template);
60 2         6 xsltSort($sortContext, $template);
61              
62 2         5 my $mode = xmlGetAttribute($template, 'mode');
63 2         6 my $top = $template->ownerDocument->documentElement;
64 2         5 for (my $i = 0; $i < $top->childNodes->length; ++$i) {
65 4         7 my $c = $top->childNodes->[$i];
66 4 50 33     13 if ($c->nodeType == ELEMENT_NODE and
      50        
      50        
      33        
67             $c->nodeName eq 'xsl:template' and
68             ($c->getAttribute('mode') || '') eq ($mode || '')) {
69 4         6 for (my $j = 0; $j < @{$sortContext->{nodelist}}; ++$j) {
  6         17  
70 2         3 my $nj = $sortContext->{nodelist}->[$j];
71 2         5 xsltProcessContext($sortContext->clone($nj, $j), $c, $output);
72             }
73             }
74             }
75              
76             } elsif ($nodename[1] eq 'attribute') {
77 0         0 my $nameexpr = xmlGetAttribute($template, 'name');
78 0         0 my $name = xsltAttributeValue($nameexpr, $input);
79 0         0 my $node = $output->ownerDocument->createDocumentFragment();
80 0         0 xsltChildNodes($input, $template, $node);
81 0         0 my $value = xmlValue($node);
82 0         0 $output->setAttribute($name, $value);
83              
84             } elsif ($nodename[1] eq 'attribute-set') {
85 0         0 warn('not implemented: ' . $nodename[1]);
86              
87             } elsif ($nodename[1] eq 'call-template') {
88 0         0 my $name = xmlGetAttribute($template, 'name');
89 0         0 my $top = $template->ownerDocument->documentElement;
90              
91 0         0 my $paramContext = $input->clone();
92 0         0 xsltWithParam($paramContext, $template);
93              
94 0         0 for (my $i = 0; $i < $top->childNodes->length; ++$i) {
95 0         0 my $c = $top->childNodes->[$i];
96 0 0 0     0 if ($c->nodeType == ELEMENT_NODE and
      0        
97             $c->nodeName eq 'xsl:template' and
98             $c->getAttribute('name') eq $name) {
99 0         0 xsltChildNodes($paramContext, $c, $output);
100 0         0 last;
101             }
102             }
103             } elsif ($nodename[1] eq 'choose') {
104 0         0 xsltChoose($input, $template, $output);
105              
106             } elsif ($nodename[1] eq 'comment') {
107 0         0 my $node = $output->ownerDocument->createDocumentFragment();
108 0         0 xsltChildNodes($input, $template, $node);
109 0         0 my $commentData = xmlValue($node);
110 0         0 my $commentNode = $output->ownerDocument->createComment($commentData);
111 0         0 $output->appendChild($commentNode);
112              
113             } elsif ($nodename[1] eq 'copy') {
114 0 0       0 if ($input->{node}->nodeType == ELEMENT_NODE) {
    0          
115 0         0 my $node = $output->ownerDocument->createElement($input->{node}->nodeName);
116 0         0 $output->appendChild($node);
117 0         0 xsltChildNodes($input, $template, $node);
118              
119             } elsif ($input->{node}->nodeType == ATTRIBUTE_NODE) {
120 0         0 my $node = $output->ownerDocument->createAttribute($input->{node}->nodeName);
121 0         0 $node->nodeValue = $input->{node}->nodeValue;
122 0         0 $output->setAttribute($node);
123             }
124              
125             } elsif ($nodename[1] eq 'copy-of') {
126 0         0 my $select = xmlGetAttribute($template, 'select');
127 0         0 my $value = xpathEval($select, $input);
128 0 0       0 if ($value->{type} eq 'node-set') {
129 0         0 my $nodes = $value->nodeSetValue();
130 0         0 for (my $i = 0; $i < @$nodes; ++$i) {
131 0         0 xsltCopyOf($output, $nodes->[$i]);
132             }
133              
134             } else {
135 0         0 my $node = $output->ownerDocument->createTextNode($value->stringValue());
136 0         0 $output->appendChild($node);
137             }
138              
139             } elsif ($nodename[1] eq 'decimal-format') {
140 0         0 warn('not implemented: ' . $nodename[1]);
141              
142             } elsif ($nodename[1] eq 'element') {
143 0         0 my $nameexpr = xmlGetAttribute($template, 'name');
144 0         0 my $name = xsltAttributeValue($nameexpr, $input);
145 0         0 my $node = $output->ownerDocument->createElement($name);
146 0         0 $output->appendChild($node);
147 0         0 xsltChildNodes($input, $template, $node);
148              
149             } elsif ($nodename[1] eq 'fallback') {
150 0         0 warn('not implemented: ' . $nodename[1]);
151              
152             } elsif ($nodename[1] eq 'for-each') {
153 0         0 my $sortContext = $input->clone();
154 0         0 xsltSort($sortContext, $template);
155 0         0 xsltForEach($sortContext, $template, $output);
156              
157             } elsif ($nodename[1] eq 'if') {
158 0         0 my $test = xmlGetAttribute($template, 'test');
159 0 0       0 if (xpathEval($test, $input)->booleanValue()) {
160 0         0 xsltChildNodes($input, $template, $output);
161             }
162              
163             } elsif ($nodename[1] eq 'import') {
164 0         0 warn('not implemented: ' . $nodename[1]);
165              
166             } elsif ($nodename[1] eq 'include') {
167 0         0 warn('not implemented: ' . $nodename[1]);
168              
169             } elsif ($nodename[1] eq 'key') {
170 0         0 warn('not implemented: ' . $nodename[1]);
171              
172             } elsif ($nodename[1] eq 'message') {
173 0         0 warn('not implemented: ' . $nodename[1]);
174              
175             } elsif ($nodename[1] eq 'namespace-alias') {
176 0         0 warn('not implemented: ' . $nodename[1]);
177              
178             } elsif ($nodename[1] eq 'number') {
179 0         0 warn('not implemented: ' . $nodename[1]);
180              
181             } elsif ($nodename[1] eq 'otherwise') {
182 0         0 warn('not implemented: ' . $nodename[1]);
183              
184             } elsif ($nodename[1] eq 'output') {
185              
186             } elsif ($nodename[1] eq 'preserve-space') {
187 0         0 warn('not implemented: ' . $nodename[1]);
188              
189             } elsif ($nodename[1] eq 'processing-instruction') {
190 0         0 warn('not implemented: ' . $nodename[1]);
191              
192             } elsif ($nodename[1] eq 'sort') {
193              
194             } elsif ($nodename[1] eq 'strip-space') {
195 0         0 warn('not implemented: ' . $nodename[1]);
196              
197             } elsif ($nodename[1] eq 'stylesheet' or $nodename[1] eq 'transform') {
198 1         4 xsltChildNodes($input, $template, $output);
199              
200             } elsif ($nodename[1] eq 'template') {
201 4         10 my $match = xmlGetAttribute($template, 'match');
202 4 100 66     15 if ($match and xpathMatch($match, $input)) {
203 3         10 xsltChildNodes($input, $template, $output);
204             }
205              
206             } elsif ($nodename[1] eq 'text') {
207 0         0 my $text = xmlValue($template);
208 0         0 my $node = $output->ownerDocument->createTextNode($text);
209 0         0 $output->appendChild($node);
210              
211             } elsif ($nodename[1] eq 'value-of') {
212 1         3 my $select = xmlGetAttribute($template, 'select');
213 1         3 my $value = xpathEval($select, $input)->stringValue();
214 1 50       15 unless ($output->ownerDocument) { die 'no ownerDocument for '.Dumper($output) }
  0         0  
215 1         4 my $node = $output->ownerDocument->createTextNode($value);
216 1         3 $output->appendChild($node);
217              
218             } elsif ($nodename[1] eq 'param') {
219 0         0 xsltVariable($input, $template, 0);
220              
221             } elsif ($nodename[1] eq 'variable') {
222 0         0 xsltVariable($input, $template, 1);
223              
224             } elsif ($nodename[1] eq 'when') {
225 0         0 warn('error if here: ' . $nodename[1]);
226              
227             } elsif ($nodename[1] eq 'with-param') {
228 0         0 warn('error if here: ' . $nodename[1]);
229              
230             } else {
231 0         0 warn('error if here: ' . $nodename[1]);
232             }
233             }
234             }
235              
236             sub xsltWithParam {
237 2     2 0 5 my ($input, $template) = @_;
238 2         7 for (my $i = 0; $i < $template->childNodes->length; ++$i) {
239 0         0 my $c = $template->childNodes->[$i];
240 0 0 0     0 if ($c->nodeType == ELEMENT_NODE and $c->nodeName eq 'xsl:with-param') {
241 0         0 xsltVariable($input, $c, 1);
242             }
243             }
244             }
245              
246             sub xsltSort {
247 2     2 0 3 my ($input, $template) = @_;
248 2         4 my $sort = [];
249 2         6 for (my $i = 0; $i < $template->childNodes->length; ++$i) {
250 0         0 my $c = $template->childNodes->[$i];
251 0 0 0     0 if ($c->nodeType == ELEMENT_NODE and $c->nodeName eq 'xsl:sort') {
252 0         0 my $select = xmlGetAttribute($c, 'select');
253 0         0 my $expr = xpathParse($select);
254 0   0     0 my $type = xmlGetAttribute($c, 'data-type') || 'text';
255 0   0     0 my $order = xmlGetAttribute($c, 'order') || 'ascending';
256 0         0 push(@$sort, { expr=> $expr, type=> $type, order=> $order });
257             }
258             }
259              
260 2         5 xpathSort($input, $sort);
261             }
262              
263             sub xsltVariable {
264 0     0 0 0 my ($input, $template, $override) = @_;
265            
266 0         0 my $name = xmlGetAttribute($template, 'name');
267 0         0 my $select = xmlGetAttribute($template, 'select');
268              
269 0         0 my $value;
270              
271 0 0       0 if ($template->childNodes->length > 0) {
    0          
272 0         0 my $root = $input->{node}->ownerDocument->createDocumentFragment();
273 0         0 xsltChildNodes($input, $template, $root);
274 0         0 $value = new NodeSetValue([$root]);
275              
276             } elsif ($select) {
277 0         0 $value = xpathEval($select, $input);
278              
279             } else {
280 0         0 $value = new StringValue('');
281             }
282              
283 0 0 0     0 if ($override || !$input->getVariable($name)) {
284 0         0 $input->setVariable($name, $value);
285             }
286             }
287              
288              
289             sub xsltChoose {
290 0     0 0 0 my ($input, $template, $output) = @_;
291 0         0 for (my $i = 0; $i < $template->childNodes->length; ++$i) {
292 0         0 my $childNode = $template->childNodes->[$i];
293 0 0       0 if ($childNode->nodeType != ELEMENT_NODE) {
    0          
    0          
294 0         0 next;
295              
296             } elsif ($childNode->nodeName eq 'xsl:when') {
297 0         0 my $test = xmlGetAttribute($childNode, 'test');
298 0 0       0 if (xpathEval($test, $input)->booleanValue()) {
299 0         0 xsltChildNodes($input, $childNode, $output);
300 0         0 last;
301             }
302              
303             } elsif ($childNode->nodeName eq 'xsl:otherwise') {
304 0         0 xsltChildNodes($input, $childNode, $output);
305 0         0 last;
306             }
307             }
308             }
309              
310              
311             sub xsltForEach {
312 0     0 0 0 my ($input, $template, $output) = @_;
313 0         0 my $select = xmlGetAttribute($template, 'select');
314 0         0 my $nodes = xpathEval($select, $input)->nodeSetValue();
315 0         0 for (my $i = 0; $i < @$nodes; ++$i) {
316 0         0 my $context = $input->clone($nodes->[$i], $i, $nodes);
317 0         0 xsltChildNodes($context, $template, $output);
318             }
319             }
320              
321              
322             sub xsltChildNodes {
323 6     6 0 10 my ($input, $template, $output, $foo) = @_;
324 6         12 my $context = $input->clone();
325 6         8 foreach my $c (@{$template->childNodes}) {
  6         15  
326 7         70 xsltProcessContext($context, $c, $output);
327             }
328             }
329              
330              
331             sub xsltPassThrough {
332 2     2 0 4 my ($input, $template, $output) = @_;
333 2 50       5 if ($template->nodeType == TEXT_NODE) {
    100          
334 0 0       0 if (xsltPassText($template)) {
335 0         0 my $node = $output->ownerDocument->createTextNode($template->nodeValue);
336 0         0 $output->appendChild($node);
337             }
338              
339             } elsif ($template->nodeType == ELEMENT_NODE) {
340 1         3 my $node = $output->ownerDocument->createElement($template->nodeName);
341 1         5 for (my $i = 0; $i < $template->attributes->length; ++$i) {
342 1         2 my $a = $template->attributes->[$i];
343 1 50       7 if ($a) {
344 1         3 my $name = $a->nodeName;
345 1         5 my $value = xsltAttributeValue($a->nodeValue, $input);
346 1         4 $node->setAttribute($name, $value);
347             }
348             }
349 1         4 $output->appendChild($node);
350 1         4 xsltChildNodes($input, $template, $node);
351              
352             } else {
353 1         4 xsltChildNodes($input, $template, $output);
354             }
355             }
356              
357             sub xsltPassText {
358 0     0 0 0 my ($template) = @_;
359 0 0       0 unless ($template->nodeValue =~ /^\s*$/) {
360 0         0 return 1;
361             }
362              
363 0         0 my $element = $template->parentNode;
364 0 0       0 if ($element->nodeName eq 'xsl:text') {
365 0         0 return 1;
366             }
367              
368 0   0     0 while ($element and $element->nodeType == ELEMENT_NODE) {
369 0         0 my $xmlspace = $element->getAttribute('xml:space');
370 0 0       0 if ($xmlspace) {
371 0 0       0 if ($xmlspace eq 'default') {
    0          
372 0         0 return 0;
373             } elsif ($xmlspace eq 'preserve') {
374 0         0 return 1;
375             }
376             }
377              
378 0         0 $element = $element->parentNode;
379             }
380              
381 0         0 return 0;
382             }
383              
384             sub xsltAttributeValue {
385 1     1 0 3 my ($value, $context) = @_;
386 1         3 my $parts = [ split(/{/, $value) ];
387 1 50       6 if (@$parts == 1) {
388 1         3 return $value;
389             }
390              
391 0         0 my $ret = '';
392 0         0 for (my $i = 0; $i < @$parts; ++$i) {
393 0         0 my $rp = [ split(/}/, $parts->[$i]) ];
394 0 0       0 if (@$rp != 2) {
395 0         0 $ret .= $parts->[$i];
396 0         0 next;
397             }
398              
399 0         0 my $val = xpathEval($rp->[0], $context)->stringValue();
400 0         0 $ret .= ($val . $rp->[1]);
401             }
402              
403 0         0 return $ret;
404             }
405              
406              
407             sub xmlGetAttribute {
408 9     9 0 14 my ($node, $name) = @_;
409 9         20 my $value = $node->getAttribute($name);
410 9 100       17 if ($value) {
411 7         12 return xmlResolveEntities($value);
412             } else {
413 2         5 return $value;
414             }
415             }
416              
417              
418             sub xsltCopyOf {
419 0     0 0 0 my ($dst, $src) = @_;
420 0 0 0     0 if ($src->nodeType == TEXT_NODE) {
    0          
    0          
    0          
421 0         0 my $node = $dst->ownerDocument->createTextNode($src->nodeValue);
422 0         0 $dst->appendChild($node);
423              
424             } elsif ($src->nodeType == ATTRIBUTE_NODE) {
425 0         0 $dst->setAttribute($src->nodeName, $src->nodeValue);
426              
427             } elsif ($src->nodeType == ELEMENT_NODE) {
428 0         0 my $node = $dst->ownerDocument->createElement($src->nodeName);
429 0         0 $dst->appendChild($node);
430              
431 0         0 for (my $i = 0; $i < $src->attributes->length; ++$i) {
432 0         0 xsltCopyOf($node, $src->attributes->[$i]);
433             }
434              
435 0         0 for (my $i = 0; $i < $src->childNodes->length; ++$i) {
436 0         0 xsltCopyOf($node, $src->childNodes->[$i]);
437             }
438              
439             } elsif ($src->nodeType == DOCUMENT_FRAGMENT_NODE or
440             $src->nodeType == DOCUMENT_NODE) {
441 0         0 for (my $i = 0; $i < $src->childNodes->length; ++$i) {
442 0         0 xsltCopyOf($dst, $src->childNodes->[$i]);
443             }
444             }
445             }
446              
447             sub xpathParse {
448 7     7 0 11 my ($match) = @_;
449 7         23 return XML::DOM::Lite::XPath->parse($match);
450             }
451              
452             sub xpathMatch {
453 4     4 0 6 my ($match, $context) = @_;
454 4         9 my $expr = xpathParse($match);
455              
456 4         5 my $ret;
457 4 50 66     22 if ($expr->{steps} and (not $expr->{absolute})
      66        
      33        
      33        
458 2         8 and (@{$expr->{steps}} == 1)
459             and ($expr->{steps}->[0]->{axis} eq 'child')
460 0         0 and (@{$expr->{steps}->[0]->{predicate}} == 0)) {
461 0         0 $ret = $expr->{steps}->[0]->{nodetest}->evaluate($context)->booleanValue();
462             } else {
463              
464 4         8 $ret = 0;
465 4         5 my $node = $context->{node};
466              
467 4   100     16 while ((not $ret) and $node) {
468 6         18 my $result = $expr->evaluate($context->clone($node,0,[$node]))->nodeSetValue();
469 6         18 for (my $i = 0; $i < @$result; ++$i) {
470 4 100       14 if ($result->[$i] == $context->{node}) {
471 3         4 $ret = 1;
472 3         5 last;
473             }
474             }
475 6         14 $node = $node->parentNode;
476             }
477             }
478              
479 4         17 return $ret;
480             }
481              
482             sub xpathSort {
483 2     2 0 7 return XML::DOM::Lite::XPath::xpathSort(@_);
484             }
485              
486             sub xpathEval {
487 3     3 0 6 my ($select, $context) = @_;
488 3         5 my $expr = xpathParse($select);
489 3         9 my $ret = $expr->evaluate($context);
490 3         8 return $ret;
491             }
492              
493             sub xmlText {
494 3     3 0 5 my ($node) = @_;
495 3         6 my $ret = '';
496 3 100 33     5 if ($node->nodeType == TEXT_NODE) {
    100          
    50          
497 1         43 $ret .= $node->nodeValue;
498              
499             } elsif ($node->nodeType == ELEMENT_NODE) {
500 1         3 $ret .= '<' . $node->nodeName;
501 1         4 for (my $i = 0; $i < $node->attributes->length; ++$i) {
502 1         3 my $a = $node->attributes->[$i];
503 1 50 33     4 if ($a and $a->nodeName and $a->nodeValue) {
      33        
504 1         4 $ret .= ' ' . $a->nodeName;
505 1         3 $ret .= '="' . $a->nodeValue . '"';
506             }
507             }
508              
509 1 50       2 if ($node->childNodes->length == 0) {
510 0         0 $ret .= '/>';
511              
512             } else {
513 1         3 $ret .= '>';
514 1         3 for (my $i = 0; $i < $node->childNodes->length; ++$i) {
515 1         3 $ret .= xmlText($node->childNodes->[$i]);
516             }
517 1         3 $ret .= 'nodeName . '>';
518             }
519              
520             } elsif ($node->nodeType == DOCUMENT_NODE or
521             $node->nodeType == DOCUMENT_FRAGMENT_NODE) {
522 1         4 for (my $i = 0; $i < $node->childNodes->length; ++$i) {
523 1         4 $ret .= xmlText($node->childNodes->[$i]);
524             }
525             }
526              
527 3         8 return $ret;
528             }
529              
530             sub xmlResolveEntities {
531 7     7 0 13 my ($s) = @_;
532              
533 7         17 my $parts = [ split(/&/, $s) ];
534              
535 7         12 my $ret = $parts->[0];
536 7         17 for (my $i = 1; $i < @$parts; ++$i) {
537 0         0 my $rp = [ split(/;/, $parts->[$i]) ];
538 0 0       0 if (@$rp == 1) {
539 0         0 $ret .= $parts->[$i];
540 0         0 next;
541             }
542            
543 0         0 my $ch;
544 0 0       0 if ($rp->[0] eq 'lt') {
    0          
    0          
    0          
    0          
    0          
545 0         0 $ch = '<';
546             } elsif ($rp->[0] eq 'gt') {
547 0         0 $ch = '>';
548             } elsif ($rp->[0] eq 'amp') {
549 0         0 $ch = '&';
550             } elsif ($rp->[0] eq 'quot') {
551 0         0 $ch = '"';
552             } elsif ($rp->[0] eq 'apos') {
553 0         0 $ch = "'";
554             } elsif ($rp->[0] eq 'nbsp') {
555 0         0 $ch = ' '; # "\x160"
556             } else {
557 0         0 warn 'unknown entity '.$rp->[0];
558             #my span = window.document.createElement('span');
559             #span.innerHTML = '&' + rp[0] + '; ';
560             #ch = span.childNodes[0].nodeValue.charAt(0);
561             }
562 0         0 $ret .= ($ch . $rp->[1]);
563             }
564              
565 7         15 return $ret;
566             }
567              
568             1;
569              
570             __END__