File Coverage

blib/lib/XML/Atom/Thing.pm
Criterion Covered Total %
statement 6 6 100.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 8 8 100.0


line stmt bran cond sub pod time code
1             # $Id$
2              
3             package XML::Atom::Thing;
4 8     8   66 use strict;
  8         13  
  8         372  
5 8     8   42 use base qw( XML::Atom::Base );
  8         14  
  8         5870  
6              
7             use XML::Atom;
8             use base qw( XML::Atom::ErrorHandler );
9             use XML::Atom::Util qw( first nodelist childlist create_element );
10             use XML::Atom::Category;
11             use XML::Atom::Link;
12             use LWP::UserAgent;
13             BEGIN {
14             if (LIBXML) {
15             *init = \&init_libxml;
16             } else {
17             *init = \&init_xpath;
18             }
19             }
20              
21             sub init_libxml {
22             my $atom = shift;
23             my %param = @_ == 1 ? (Stream => $_[0]) : @_;
24             if (my $stream = delete $param{Stream}) {
25             my $parser = delete $param{Parser} || XML::Atom->libxml_parser;
26             my $doc;
27             if (ref($stream) eq 'SCALAR') {
28             $doc = $parser->parse_string($$stream);
29             } elsif (ref($stream)) {
30             $doc = $parser->parse_fh($stream);
31             } else {
32             $doc = $parser->parse_file($stream);
33             }
34             $param{Elem} = $doc->getDocumentElement;
35             } elsif (my $doc = delete $param{Doc}) {
36             $param{Elem} = $doc->getDocumentElement;
37             }
38             $atom->SUPER::init(%param);
39             $atom->fixup_ns;
40             return $atom;
41             }
42              
43             sub fixup_ns {
44             my $obj = shift;
45             $obj->{ns} = $obj->elem->namespaceURI;
46             }
47              
48             sub init_xpath {
49             my $atom = shift;
50             my %param = @_ == 1 ? (Stream => $_[0]) : @_;
51             my $elem_name = $atom->element_name;
52             if (my $stream = delete $param{Stream}) {
53             my $parser = delete $param{Parser} || XML::Atom->expat_parser;
54             my $xp;
55             if (ref($stream) eq 'SCALAR') {
56             $xp = XML::XPath->new(xml => $$stream, parser => $parser);
57             } elsif (ref($stream)) {
58             $xp = XML::XPath->new(ioref => $stream, parser => $parser);
59             } else {
60             $xp = XML::XPath->new(filename => $stream, parser => $parser);
61             }
62             my $set = $xp->find('/' . $elem_name);
63             unless ($set && $set->size) {
64             $set = $xp->find('/');
65             }
66             $param{Elem} = ($set->get_nodelist)[0];
67             } elsif (my $doc = delete $param{Doc}) {
68             $param{Elem} = $doc;
69             } elsif (my $elem = $param{Elem}) {
70             my $xp = XML::XPath->new(context => $elem);
71             my $set = $xp->find('/' . $elem_name);
72             unless ($set && $set->size) {
73             $set = $xp->find('/');
74             }
75             $param{Elem} = ($set->get_nodelist)[0];
76             }
77             $atom->SUPER::init(%param);
78             $atom;
79             }
80              
81             sub set {
82             my $atom = shift;
83             my($ns, $name, $val, $attr, $add) = @_;
84             if (ref($val) =~ /Element$/) {
85             $atom->elem->appendChild($val);
86             return $val;
87             } else {
88             return $atom->SUPER::set(@_);
89             }
90             }
91              
92             # common elements
93             __PACKAGE__->mk_elem_accessors(qw( icon id logo title )); # updated & rights are in renamed
94              
95             # common multiple elements
96             __PACKAGE__->mk_object_list_accessor('link' => 'XML::Atom::Link', 'links');
97             __PACKAGE__->mk_object_list_accessor('category' => 'XML::Atom::Category', 'categories');
98             __PACKAGE__->mk_object_list_accessor('author' => 'XML::Atom::Person', 'authors');
99             __PACKAGE__->mk_object_list_accessor('contributor' => 'XML::Atom::Person', 'contributors');
100              
101             __PACKAGE__->_rename_elements('copyright' => 'rights');
102              
103             # 0.3 -> 1.0 elements aliasing
104             sub _rename_elements {
105             my($class, $atom03, $atom10) = @_;
106             no strict 'refs';
107             *{"$class\::$atom03"} = sub {
108             my $self = shift;
109             if ($self->version eq "1.0") {
110             return $self->$atom10(@_);
111             }
112             @_ > 0 ? $self->set($self->ns, $atom03, @_) : $self->get($self->ns, $atom03);
113             };
114              
115             *{"$class\::$atom10"} = sub {
116             my $self = shift;
117             if ($self->version eq "0.3") {
118             return $self->$atom03(@_);
119             }
120             @_ > 0 ? $self->set($self->ns, $atom10, @_) : $self->get($self->ns, $atom10);
121             };
122             }
123              
124             1;