| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # $Id$ | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | package XML::Atom::Thing; | 
| 4 | 19 |  |  | 19 |  | 160 | use strict; | 
|  | 19 |  |  |  |  | 70 |  | 
|  | 19 |  |  |  |  | 667 |  | 
| 5 | 19 |  |  | 19 |  | 99 | use base qw( XML::Atom::Base ); | 
|  | 19 |  |  |  |  | 38 |  | 
|  | 19 |  |  |  |  | 8517 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 19 |  |  | 19 |  | 186 | use XML::Atom; | 
|  | 19 |  |  |  |  | 43 |  | 
|  | 19 |  |  |  |  | 1003 |  | 
| 8 | 19 |  |  | 19 |  | 164 | use base qw( XML::Atom::ErrorHandler ); | 
|  | 19 |  |  |  |  | 35 |  | 
|  | 19 |  |  |  |  | 760 |  | 
| 9 | 19 |  |  | 19 |  | 111 | use XML::Atom::Util qw( first nodelist childlist create_element ); | 
|  | 19 |  |  |  |  | 33 |  | 
|  | 19 |  |  |  |  | 984 |  | 
| 10 | 19 |  |  | 19 |  | 8860 | use XML::Atom::Category; | 
|  | 19 |  |  |  |  | 49 |  | 
|  | 19 |  |  |  |  | 566 |  | 
| 11 | 19 |  |  | 19 |  | 8196 | use XML::Atom::Link; | 
|  | 19 |  |  |  |  | 60 |  | 
|  | 19 |  |  |  |  | 562 |  | 
| 12 | 19 |  |  | 19 |  | 12576 | use LWP::UserAgent; | 
|  | 19 |  |  |  |  | 764794 |  | 
|  | 19 |  |  |  |  | 1317 |  | 
| 13 |  |  |  |  |  |  | BEGIN { | 
| 14 | 19 |  |  | 19 |  | 75 | if (LIBXML) { | 
| 15 | 19 |  |  |  |  | 12636 | *init = \&init_libxml; | 
| 16 |  |  |  |  |  |  | } else { | 
| 17 |  |  |  |  |  |  | *init = \&init_xpath; | 
| 18 |  |  |  |  |  |  | } | 
| 19 |  |  |  |  |  |  | } | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | sub init_libxml { | 
| 22 | 102 |  |  | 102 | 0 | 181 | my $atom = shift; | 
| 23 | 102 | 100 |  |  |  | 356 | my %param = @_ == 1 ? (Stream => $_[0]) : @_; | 
| 24 | 102 | 100 |  |  |  | 382 | if (my $stream = delete $param{Stream}) { | 
|  |  | 50 |  |  |  |  |  | 
| 25 | 17 |  | 66 |  |  | 151 | my $parser = delete $param{Parser} || XML::Atom->libxml_parser; | 
| 26 | 17 |  |  |  |  | 1796 | my $doc; | 
| 27 | 17 | 100 |  |  |  | 76 | if (ref($stream) eq 'SCALAR') { | 
|  |  | 100 |  |  |  |  |  | 
| 28 | 8 |  |  |  |  | 34 | $doc = $parser->parse_string($$stream); | 
| 29 |  |  |  |  |  |  | } elsif (ref($stream)) { | 
| 30 | 1 |  |  |  |  | 5 | $doc = $parser->parse_fh($stream); | 
| 31 |  |  |  |  |  |  | } else { | 
| 32 | 8 |  |  |  |  | 37 | $doc = $parser->parse_file($stream); | 
| 33 |  |  |  |  |  |  | } | 
| 34 | 17 |  |  |  |  | 8224 | $param{Elem} = $doc->getDocumentElement; | 
| 35 |  |  |  |  |  |  | } elsif (my $doc = delete $param{Doc}) { | 
| 36 | 0 |  |  |  |  | 0 | $param{Elem} = $doc->getDocumentElement; | 
| 37 |  |  |  |  |  |  | } | 
| 38 | 102 |  |  |  |  | 465 | $atom->SUPER::init(%param); | 
| 39 | 102 |  |  |  |  | 368 | $atom->fixup_ns; | 
| 40 | 102 |  |  |  |  | 407 | return $atom; | 
| 41 |  |  |  |  |  |  | } | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | sub fixup_ns { | 
| 44 | 102 |  |  | 102 | 0 | 161 | my $obj = shift; | 
| 45 | 102 |  |  |  |  | 308 | $obj->{ns} = $obj->elem->namespaceURI; | 
| 46 |  |  |  |  |  |  | } | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | sub init_xpath { | 
| 49 | 0 |  |  | 0 | 0 | 0 | my $atom = shift; | 
| 50 | 0 | 0 |  |  |  | 0 | my %param = @_ == 1 ? (Stream => $_[0]) : @_; | 
| 51 | 0 |  |  |  |  | 0 | my $elem_name = $atom->element_name; | 
| 52 | 0 | 0 |  |  |  | 0 | if (my $stream = delete $param{Stream}) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 53 | 0 |  | 0 |  |  | 0 | my $parser = delete $param{Parser} || XML::Atom->expat_parser; | 
| 54 | 0 |  |  |  |  | 0 | my $xp; | 
| 55 | 0 | 0 |  |  |  | 0 | if (ref($stream) eq 'SCALAR') { | 
|  |  | 0 |  |  |  |  |  | 
| 56 | 0 |  |  |  |  | 0 | $xp = XML::XPath->new(xml => $$stream, parser => $parser); | 
| 57 |  |  |  |  |  |  | } elsif (ref($stream)) { | 
| 58 | 0 |  |  |  |  | 0 | $xp = XML::XPath->new(ioref => $stream, parser => $parser); | 
| 59 |  |  |  |  |  |  | } else { | 
| 60 | 0 |  |  |  |  | 0 | $xp = XML::XPath->new(filename => $stream, parser => $parser); | 
| 61 |  |  |  |  |  |  | } | 
| 62 | 0 |  |  |  |  | 0 | my $set = $xp->find('/' . $elem_name); | 
| 63 | 0 | 0 | 0 |  |  | 0 | unless ($set && $set->size) { | 
| 64 | 0 |  |  |  |  | 0 | $set = $xp->find('/'); | 
| 65 |  |  |  |  |  |  | } | 
| 66 | 0 |  |  |  |  | 0 | $param{Elem} = ($set->get_nodelist)[0]; | 
| 67 |  |  |  |  |  |  | } elsif (my $doc = delete $param{Doc}) { | 
| 68 | 0 |  |  |  |  | 0 | $param{Elem} = $doc; | 
| 69 |  |  |  |  |  |  | } elsif (my $elem = $param{Elem}) { | 
| 70 | 0 |  |  |  |  | 0 | my $xp = XML::XPath->new(context => $elem); | 
| 71 | 0 |  |  |  |  | 0 | my $set = $xp->find('/' . $elem_name); | 
| 72 | 0 | 0 | 0 |  |  | 0 | unless ($set && $set->size) { | 
| 73 | 0 |  |  |  |  | 0 | $set = $xp->find('/'); | 
| 74 |  |  |  |  |  |  | } | 
| 75 | 0 |  |  |  |  | 0 | $param{Elem} = ($set->get_nodelist)[0]; | 
| 76 |  |  |  |  |  |  | } | 
| 77 | 0 |  |  |  |  | 0 | $atom->SUPER::init(%param); | 
| 78 | 0 |  |  |  |  | 0 | $atom; | 
| 79 |  |  |  |  |  |  | } | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | sub set { | 
| 82 | 35 |  |  | 35 | 0 | 1431 | my $atom = shift; | 
| 83 | 35 |  |  |  |  | 98 | my($ns, $name, $val, $attr, $add) = @_; | 
| 84 | 35 | 50 |  |  |  | 131 | if (ref($val) =~ /Element$/) { | 
| 85 | 0 |  |  |  |  | 0 | $atom->elem->appendChild($val); | 
| 86 | 0 |  |  |  |  | 0 | return $val; | 
| 87 |  |  |  |  |  |  | } else { | 
| 88 | 35 |  |  |  |  | 190 | 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 | 95 |  |  | 95 |  | 241 | my($class, $atom03, $atom10) = @_; | 
| 106 | 19 |  |  | 19 |  | 216 | no strict 'refs'; | 
|  | 19 |  |  |  |  | 46 |  | 
|  | 19 |  |  |  |  | 4713 |  | 
| 107 | 95 |  |  |  |  | 414 | *{"$class\::$atom03"} = sub { | 
| 108 | 13 |  |  | 13 |  | 1250 | my $self = shift; | 
| 109 | 13 | 100 |  |  |  | 42 | if ($self->version eq "1.0") { | 
| 110 | 5 |  |  |  |  | 23 | return $self->$atom10(@_); | 
| 111 |  |  |  |  |  |  | } | 
| 112 | 8 | 100 |  |  |  | 82 | @_ > 0 ? $self->set($self->ns, $atom03, @_) : $self->get($self->ns, $atom03); | 
| 113 | 95 |  |  |  |  | 340 | }; | 
| 114 |  |  |  |  |  |  |  | 
| 115 | 95 |  |  |  |  | 463 | *{"$class\::$atom10"} = sub { | 
| 116 | 10 |  |  | 10 |  | 21 | my $self = shift; | 
| 117 | 10 | 100 |  |  |  | 23 | if ($self->version eq "0.3") { | 
| 118 | 1 |  |  |  |  | 4 | return $self->$atom03(@_); | 
| 119 |  |  |  |  |  |  | } | 
| 120 | 9 | 50 |  |  |  | 34 | @_ > 0 ? $self->set($self->ns, $atom10, @_) : $self->get($self->ns, $atom10); | 
| 121 | 95 |  |  |  |  | 355 | }; | 
| 122 |  |  |  |  |  |  | } | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | 1; |