local-lib5/lib/perl5/XML/Atom/Thing.pm

   1 # $Id$
   2
   3 package XML::Atom::Thing;
   4 use strict;
   5 use base qw( XML::Atom::Base );
   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 = XML::LibXML->new;
  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 $xp;
  54         if (ref($stream) eq 'SCALAR') {
  55             $xp = XML::XPath->new(xml => $$stream);
  56         } elsif (ref($stream)) {
  57             $xp = XML::XPath->new(ioref => $stream);
  58         } else {
  59             $xp = XML::XPath->new(filename => $stream);
  60         }
  61         my $set = $xp->find('/' . $elem_name);
  62         unless ($set && $set->size) {
  63             $set = $xp->find('/');
  64         }
  65         $param{Elem} = ($set->get_nodelist)[0];
  66     } elsif (my $doc = delete $param{Doc}) {
  67         $param{Elem} = $doc;
  68     } elsif (my $elem = $param{Elem}) {
  69         my $xp = XML::XPath->new(context => $elem);
  70         my $set = $xp->find('/' . $elem_name);
  71         unless ($set && $set->size) {
  72             $set = $xp->find('/');
  73         }
  74         $param{Elem} = ($set->get_nodelist)[0];
  75     }
  76     $atom->SUPER::init(%param);
  77     $atom;
  78 }
  79
  80 sub set {
  81     my $atom = shift;
  82     my($ns, $name, $val, $attr, $add) = @_;
  83     if (ref($val) =~ /Element$/) {
  84         $atom->elem->appendChild($val);
  85         return $val;
  86     } else {
  87         return $atom->SUPER::set(@_);
  88     }
  89 }
  90
  91 # common elements
  92 __PACKAGE__->mk_elem_accessors(qw( icon id logo title )); # updated & rights are in renamed
  93
  94 # common multiple elements
  95 __PACKAGE__->mk_object_list_accessor('link' => 'XML::Atom::Link', 'links');
  96 __PACKAGE__->mk_object_list_accessor('category' => 'XML::Atom::Category', 'categories');
  97 __PACKAGE__->mk_object_list_accessor('author' => 'XML::Atom::Person', 'authors');
  98 __PACKAGE__->mk_object_list_accessor('contributor' => 'XML::Atom::Person', 'contributors');
  99
 100 __PACKAGE__->_rename_elements('copyright' => 'rights');
 101
 102 # 0.3 -> 1.0 elements aliasing
 103 sub _rename_elements {
 104     my($class, $atom03, $atom10) = @_;
 105     no strict 'refs';
 106     *{"$class\::$atom03"} = sub {
 107         my $self = shift;
 108         if ($self->version eq "1.0") {
 109             return $self->$atom10(@_);
 110         }
 111         @_ > 0 ? $self->set($self->ns, $atom03, @_) : $self->get($self->ns, $atom03);
 112     };
 113
 114     *{"$class\::$atom10"} = sub {
 115         my $self = shift;
 116         if ($self->version eq "0.3") {
 117             return $self->$atom03(@_);
 118         }
 119         @_ > 0 ? $self->set($self->ns, $atom10, @_) : $self->get($self->ns, $atom10);
 120     };
 121 }
 122
 123 1;