File Coverage

blib/lib/XML/RSS/LibXML/ImplBase.pm
Criterion Covered Total %
statement 18 262 6.8
branch 0 102 0.0
condition 0 32 0.0
subroutine 6 41 14.6
pod 0 35 0.0
total 24 472 5.0


line stmt bran cond sub pod time code
1             # $Id$
2             #
3             # Copyright (c) 2005-2007 Daisuke Maki
4             # All rights reserved.
5              
6             package XML::RSS::LibXML::ImplBase;
7 1     1   6 use strict;
  1         2  
  1         25  
8 1     1   4 use warnings;
  1         2  
  1         21  
9 1     1   5 use base qw(Class::Accessor::Fast);
  1         2  
  1         74  
10 1     1   11 use Carp qw(croak);
  1         2  
  1         52  
11 1     1   506 use XML::RSS::LibXML::MagicElement;
  1         2  
  1         7  
12 1     1   445 use XML::RSS::LibXML::Namespaces;
  1         1  
  1         2719  
13              
14             sub rss_accessor
15             {
16 0     0 0   my $self = shift;
17 0           my $name = shift;
18 0           my $c = shift;
19              
20 0 0         if (! exists $c->{$name}) {
21 0           croak "Unregistered entity: Can't access $name field in object of class " . ref($self);
22             }
23              
24 0           my $ret;
25              
26              
27 0 0         if (@_ == 1) {
    0          
28 0 0         if (ref $_[0]) { # eval { $_[0]->isa('XML::RSS::LibXML::MagicElement') }) {
29 0           $ret = $c->{$name};
30 0           $c->{$name} = $_[0];
31             } else {
32 0           $ret = $c->{$name}->{$_[0]};
33 0 0 0       if (ref $ret && eval { $ret->isa('XML::RSS::LibXML::ElementSpec') }) {
  0            
34 0           $ret = undef;
35             }
36             }
37             } elsif (@_ > 1) {
38 0           my %hash = @_;
39 0           my $definition = $self->accessor_definition;
40              
41 0           foreach my $key (keys %hash) {
42 0 0         $self->validate_accessor($definition, $name, $key, $hash{$key}) if $definition;
43              
44 0 0         if ($key =~ /^(?:rdf|dc|syn|taxo|admin|content|cc)$/) {
45 0 0         if (! exists $c->namespaces->{$key}) {
46 0           $c->add_module(prefix => $key, uri => XML::RSS::LibXML::Namespaces::lookup_uri($key));
47             }
48             }
49              
50             # $self->store_element($c, $c->{$name}, $key, $hash{$key});
51 0           $self->set_value($c, $name, $key, $hash{$key});
52 0 0         if (my $uri = $c->namespaces->{$key}) {
53 0           $self->set_value($c, $name, $uri, $hash{$key});
54             # $self->store_element($c, $c->{$name}, $uri, $hash{$key});
55             }
56             }
57 0           $ret = $c->{$name};
58             } else {
59 0           $ret = $c->{$name};
60 0 0 0       if (ref $ret && eval { $ret->isa('XML::RSS::LibXML::ElementSpec') }) {
  0            
61 0           $ret = undef;
62             }
63             }
64              
65 0           return $ret;
66             }
67              
68 0     0 0   sub definition {}
69 0     0 0   sub accessor_definition { }
70              
71             sub validate_accessor
72             {
73 0     0 0   my ($self, $definition, $prefix, $key, $value) = @_;
74              
75 0 0         if (! defined $value) {
76 0           croak "Undefined value in XML::RSS::LibXML::validate_accessor";
77             }
78 0           my $spec = $definition->{$prefix}{$key};
79 0 0 0       croak "$key cannot exceed " . $spec->[1] . " characters in length"
80             if defined $spec->[1] && length($value) > $spec->[1];
81             }
82              
83             sub set_value
84             {
85 0     0 0   my ($self, $c, $prefix, $key, $value) = @_;
86              
87 0 0         if (eval { $c->{$prefix}->isa('XML::RSS::LibXML::ElementSpec') }) {
  0            
88 0           $c->{$prefix} = +{ %{ $c->{$prefix} } };
  0            
89             }
90 0           $c->{$prefix}{$key} = $value;
91             }
92              
93 0     0 0   sub validate_item { }
94              
95 0     0 0   sub channel { shift->rss_accessor('channel', @_) }
96 0     0 0   sub image { shift->rss_accessor('image', @_) }
97 0     0 0   sub textinput { shift->rss_accessor('textinput', @_) }
98 0     0 0   sub skipDays { shift->rss_accessor('skipDays', @_) }
99 0     0 0   sub skipHours { shift->rss_accessor('skipHours', @_) }
100              
101             sub reset
102             {
103 0     0 0   my ($self, $c) = @_;
104              
105             # internal hash
106 0           $c->_internal({});
107              
108             # init num of items to 0
109 0           $c->num_items(0);
110              
111             # initialize items
112 0           $c->{items} = [];
113              
114 0           my $definition = $self->definition;
115 0           while (my ($k, $v) = each(%$definition)) {
116 0           $c->{$k} = +{%{$v}};
  0            
117 0 0         bless($c->{$k}, 'XML::RSS::LibXML::ElementSpec')
118             if (ref($v) eq 'XML::RSS::LibXML::ElementSpec');
119             }
120              
121 0           return;
122             }
123              
124             sub store_element
125             {
126 0     0 0   my ($self, $container, $name, $value) = @_;
127              
128 0           my $v = $container->{$name};
129 0 0 0       if (! $v || eval { $v->isa('XML::RSS::LibXML::ElementSpec') }) {
  0 0          
130 0           $container->{$name} = $value;
131             } elsif (ref($v) eq 'ARRAY') {
132 0           push @$v, $value;
133             } else {
134 0           $container->{$name} = [ $v, $value ];
135             }
136             }
137              
138 0     0 0   sub parse_dom { }
139              
140             sub parse_base
141             {
142 0     0 0   my ($self, $c, $dom) = @_;
143 0           my $xc = $c->create_xpath_context(scalar $c->namespaces);
144 0 0         if (my $b = $xc->findvalue('/rss/@xml:base', $dom)) {
145 0           $c->base($b);
146             } else {
147 0           $c->base(undef);
148             }
149             }
150              
151             sub parse_namespaces
152             {
153 0     0 0   my ($self, $c, $dom) = @_;
154              
155 0           my %namespaces = $self->parse_namespaces_recurse($c, $dom->documentElement());
156              
157 0           while (my ($prefix, $uri) = each %namespaces) {
158 0           $c->add_module(prefix => $prefix, uri => $uri);
159             }
160             }
161              
162             sub parse_namespaces_recurse
163             {
164 0     0 0   my ($self, $c, $parent) = @_;
165              
166 0           my %namespaces;
167 0           foreach my $node ($parent->findnodes('./*')) {
168 0           my %h = $self->parse_namespaces_recurse($c, $node);
169 0           %namespaces = (%namespaces, %h);
170             }
171 0           return (%namespaces, $c->get_namespaces($parent));
172             }
173              
174             sub parse_taxo
175             {
176 0     0 0   my ($self, $c, $dom, $container, $parent) = @_;
177              
178 0           my $xc = $c->create_xpath_context(scalar $c->namespaces);
179 0           my @nodes = $xc->findnodes('taxo:topics/rdf:Bag/rdf:li', $parent);
180 0 0         return unless @nodes;
181              
182 0           my $uri = XML::RSS::LibXML::Namespaces::lookup_uri('taxo');
183 0 0         if (! exists $c->namespaces->{taxo}) {
184 0           $c->add_module(prefix => 'taxo', uri => $uri);
185             }
186              
187 0   0       $container->{taxo} ||= [];
188 0           foreach my $p (@nodes) {
189 0           push @{ $container->{taxo} }, $p->findvalue('@resource');
  0            
190             }
191 0           $container->{$uri} = $container->{taxo};
192             }
193            
194             sub parse_misc_simple
195 0     0 0   {
196             }
197              
198             sub may_have_children {
199 0     0 0   qw(channel item image textinput skipHours skipDays)
200             }
201              
202             sub parse_children
203             {
204 0     0 0   my ($self, $c, $node, $xpath) = @_;
205              
206 0           my %h;
207              
208 0   0       $xpath ||= './*';
209 0           my $xc = $c->create_xpath_context(scalar $c->namespaces);
210 0           foreach my $child ($xc->findnodes($xpath, $node)) {
211 0           my $prefix = $child->getPrefix();
212 0           my $name = $child->localname();
213             # XXX - this is probably the only case where we need to explicitly
214             # normalize a name
215 0 0         $name = 'textinput' if ($name eq 'textInput');
216 0           my $val = undef;
217 0 0         if ($child->findnodes('./*')) {
218 0 0         if (!grep { $_ eq $name } $self->may_have_children) {
  0            
219             # Urk. Should have been encoded and wasn't! Stupid thing.
220 0           $val = join '', map { $_->toString } $child->childNodes;
  0            
221             } else {
222 0           $val = $self->parse_children($c, $child);
223             }
224             } else {
225 0           my $text = $child->textContent();
226 0 0         $text = '' if $text !~ /\S/ ;
227              
228             # argh. it has attributes. we do our little hack...
229 0 0         if ($child->hasAttributes) {
230 0           $val = XML::RSS::LibXML::MagicElement->new(
231             content => $text,
232             attributes => [ $child->attributes ]
233             );
234             } else {
235 0           $val = $text;
236             }
237             }
238              
239             # XXX - XML::RSS now can store multiple elements in a slot.
240             # This we detect and change the underlying structure from a
241             # scalar to an array
242              
243 0 0         if ($prefix) {
244 0   0       $h{$prefix} ||= {};
245 0           $self->store_element($h{$prefix}, $name, $val);
246              
247             # XML::RSS requires us to allow access to elements both from
248             # the prefix and the namespace
249 0   0       $h{$c->{namespaces}{$prefix}} ||= {};
250 0           $self->store_element($h{$c->{namespaces}{$prefix}}, $name, $val);
251             } else {
252 0           $self->store_element(\%h, $name, $val);
253             }
254             }
255 0 0         return wantarray ? %h : \%h;
256             }
257              
258             sub as_string
259             {
260 0     0 0   my ($self, $c, $format) = @_;
261              
262 0           my $dom = $self->create_dom($c);
263 0           return $dom->toString($format);
264             }
265              
266             sub create_dom
267             {
268 0     0 0   my ($self, $c) = @_;
269              
270 0           my $dom = $self->create_document($c);
271 0           $self->create_dtd($c, $dom);
272 0           $self->create_pi($c, $dom);
273 0           $self->create_rootelement($c, $dom);
274 0           $self->create_namespaces($c, $dom);
275 0           $self->create_channel($c, $dom);
276 0           $self->create_items($c, $dom);
277              
278 0           return $dom;
279             }
280              
281             sub create_pi
282             {
283 0     0 0   my ($self, $c, $dom) = @_;
284              
285 0           my $styles = $c->stylesheets;
286 0           foreach my $style (@$styles) {
287 0           my $pi = $dom->createProcessingInstruction('xml-stylesheet');
288 0           $pi->setData(type => 'text/xsl', href => $style);
289 0           $dom->appendChild($pi);
290             }
291             }
292              
293             sub create_document
294             {
295 0     0 0   my $self = shift;
296 0           my $c = shift;
297 0           return XML::LibXML::Document->new('1.0', $c->encoding);
298             }
299              
300 0     0 0   sub create_rootelement {}
301 0     0 0   sub create_dtd {}
302 0     0 0   sub create_channel {}
303 0     0 0   sub create_items {}
304              
305             sub create_misc_simple
306             {
307 0     0 0   my ($self, $c, $dom, $parent) = @_;
308              
309 0           my $definition = $self->definition;
310 0           while (my($p, $children) = each %$definition) {
311 0 0         next if ! $c->{$p};
312              
313 0           my @nodes;
314 0           while (my($e, $value) = each %$children) {
315 0 0         if (defined $value) {
316 0           my $node = $dom->createElement($e);
317 0           $node->appendText($value);
318 0           push @nodes, $node;
319             }
320             }
321              
322 0 0         if (@nodes) {
323 0           my $local_parent = $dom->createElement($p);
324 0           $local_parent->appendChild($_) for @nodes;
325 0           $parent->appendChild($local_parent);
326             }
327             }
328             }
329              
330             sub create_taxo
331             {
332 0     0 0   my ($self, $c, $dom, $parent) = @_;
333              
334 0           my $list = $c->{taxo};
335 0 0 0       if (! $list || @$list <= 0) {
336 0           return;
337             }
338              
339 0           my $topic = $dom->createElement('taxo:topics');
340 0           my $bag = $dom->createElement('rdf:Bag');
341 0           foreach my $taxo (@$list) {
342 0           my $node = $dom->createElement('rdf:li');
343 0           $node->setAttribute(resource => $taxo);
344 0           $bag->appendChild($node);
345             }
346 0           $topic->appendChild($bag);
347 0           $parent->appendChild($topic);
348             }
349              
350             sub create_extra_modules
351             {
352 0     0 0   my ($self, $c, $dom, $parent, $namespaces) = @_;
353              
354 0           while (my ($prefix, $uri) = each %$namespaces) {
355 0 0         next if $prefix =~ /^(?:dc|syn|taxo|rss\d\d)$/;
356 0 0         next if ! defined $c->{$prefix};
357              
358 0           while (my($e, $value) = each %{ $c->{$prefix} }) {
  0            
359 0           my $node = $dom->createElement("$prefix:$e");
360 0           $node->appendText($value);
361 0           $parent->appendChild($node);
362             }
363             }
364             }
365            
366             sub create_namespaces
367             {
368 0     0 0   my $self = shift;
369 0           my $c = shift;
370 0           my $dom = shift;
371 0 0         my $root = $dom->getDocumentElement() or
372             croak "No document element found?!";
373 0           my $namespaces = $c->namespaces;
374 0           while (my($prefix, $url) = each %$namespaces) {
375 0 0         next if $prefix =~ /^rss\d\d$/;
376 0 0         next if $prefix =~ /^#default$/;
377 0           $root->setNamespace($url, $prefix, 0);
378             }
379             }
380              
381             sub create_element_from_spec
382             {
383 0     0 0   my ($self, $c, $dom, $parent, $specs) = @_;
384              
385 0           my $root = $dom->getDocumentElement();
386              
387 0           my $node;
388 0           while (my ($e, $spec) = each %$specs) {
389 0           my( $callback, $list );
390 0 0         if (ref $spec eq 'HASH') {
    0          
391 0           $callback = $spec->{callback};
392 0           $list = $spec->{candidates};
393             } elsif (ref $spec eq 'ARRAY') {
394 0           $list = $spec;
395             }
396 0           foreach my $p (@$list) {
397 0           my ($prefix, $value);
398 0 0 0       if (ref $p && ref $p eq 'HASH') {
399 0 0         if ($c->{$p->{module}}) {
400 0           $prefix = $p->{module};
401 0           $value = $c->{$p->{module}}{$p->{element}};
402             }
403             } else {
404 0           $value = $c->{$p};
405             }
406              
407 0 0         if (defined $value) {
408 0 0         if ($prefix) {
409 0           $root->setNamespace(
410             XML::RSS::LibXML::Namespaces::lookup_uri($prefix),
411             $prefix,
412             0
413             );
414             }
415              
416 0           $node = $dom->createElement($e);
417 0 0 0       if (ref $value && eval { $value->isa('XML::RSS::LibXML::MagicElement') }) {
  0 0          
418 0           foreach my $attr ($value->attributes) {
419 0           $node->setAttribute($attr, $value->{$attr});
420             }
421             } elsif ($callback) {
422 0           $callback->($value);
423             }
424 0           $node->appendText($value);
425 0           $parent->appendChild($node);
426 0           last;
427             }
428             }
429             }
430             }
431              
432             sub add_item
433             {
434 0     0 0   my $self = shift;
435 0           my $c = shift;
436 0 0         my $h = ref($_[0]) eq 'HASH' ? $_[0] : {@_};
437              
438 0           $self->validate_item($c, $h);
439              
440 0           my $guid = $h->{guid};
441 0 0         if (defined $guid) {
    0          
442             # guid should *only* be MagicElement
443 0 0         if (! eval { $guid->isa('XML::RSS::LibXML::MagicElement') }) {
  0            
444 0           $h->{permaLink} = $guid;
445             } else {
446 0 0         if (my $is_permalink = $guid->{isPermaLink}) {
447 0 0         if ($is_permalink eq 'true') {
448 0           $h->{permaLink} = $guid->{_content};
449             }
450             } else {
451 0           $h->{permaLink} = $guid->{_content};
452             }
453             }
454             } elsif (defined (my $permaLink = $h->{permaLink})) {
455 0           $h->{guid} = XML::RSS::LibXML::MagicElement->new(
456             content => $permaLink,
457             attributes => { isPermaLink => 'true' }
458             );
459             }
460              
461 0           my $namespaces = $c->namespaces;
462 0           foreach my $p (keys %$namespaces) {
463 0 0         if ($h->{$p}) {
464 0           $h->{ $namespaces->{$p} } = $h->{$p};
465             }
466             }
467              
468             # add the item to the list
469 0 0 0       if (defined($h->{mode}) && delete $h->{mode} eq 'insert') {
470 0           unshift(@{$c->items}, $h);
  0            
471             }
472             else {
473 0           push(@{$c->items}, $h);
  0            
474             }
475              
476             # return reference to the list of items
477 0           return $c->{items};
478             }
479              
480             1;
481              
482             __END__