The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# $Id$

package XML::Atom::Thing;
use strict;
use base qw( XML::Atom::Base );

use XML::Atom;
use base qw( XML::Atom::ErrorHandler );
use XML::Atom::Util qw( first nodelist childlist create_element );
use XML::Atom::Category;
use XML::Atom::Link;
use LWP::UserAgent;
BEGIN {
    if (LIBXML) {
        *init = \&init_libxml;
    } else {
        *init = \&init_xpath;
    }
}

sub init_libxml {
    my $atom = shift;
    my %param = @_ == 1 ? (Stream => $_[0]) : @_;
    if (my $stream = delete $param{Stream}) {
        my $parser = delete $param{Parser} || XML::Atom->libxml_parser;
        my $doc;
        if (ref($stream) eq 'SCALAR') {
            $doc = $parser->parse_string($$stream);
        } elsif (ref($stream)) {
            $doc = $parser->parse_fh($stream);
        } else {
            $doc = $parser->parse_file($stream);
        }
        $param{Elem} = $doc->getDocumentElement;
    } elsif (my $doc = delete $param{Doc}) {
        $param{Elem} = $doc->getDocumentElement;
    }
    $atom->SUPER::init(%param);
    $atom->fixup_ns;
    return $atom;
}

sub fixup_ns {
    my $obj = shift;
    $obj->{ns} = $obj->elem->namespaceURI;
}

sub init_xpath {
    my $atom = shift;
    my %param = @_ == 1 ? (Stream => $_[0]) : @_;
    my $elem_name = $atom->element_name;
    if (my $stream = delete $param{Stream}) {
        my $parser = delete $param{Parser} || XML::Atom->expat_parser;
        my $xp;
        if (ref($stream) eq 'SCALAR') {
            $xp = XML::XPath->new(xml => $$stream, parser => $parser);
        } elsif (ref($stream)) {
            $xp = XML::XPath->new(ioref => $stream, parser => $parser);
        } else {
            $xp = XML::XPath->new(filename => $stream, parser => $parser);
        }
        my $set = $xp->find('/' . $elem_name);
        unless ($set && $set->size) {
            $set = $xp->find('/');
        }
        $param{Elem} = ($set->get_nodelist)[0];
    } elsif (my $doc = delete $param{Doc}) {
        $param{Elem} = $doc;
    } elsif (my $elem = $param{Elem}) {
        my $xp = XML::XPath->new(context => $elem);
        my $set = $xp->find('/' . $elem_name);
        unless ($set && $set->size) {
            $set = $xp->find('/');
        }
        $param{Elem} = ($set->get_nodelist)[0];
    }
    $atom->SUPER::init(%param);
    $atom;
}

sub set {
    my $atom = shift;
    my($ns, $name, $val, $attr, $add) = @_;
    if (ref($val) =~ /Element$/) {
        $atom->elem->appendChild($val);
        return $val;
    } else {
        return $atom->SUPER::set(@_);
    }
}

# common elements
__PACKAGE__->mk_elem_accessors(qw( icon id logo title )); # updated & rights are in renamed

# common multiple elements
__PACKAGE__->mk_object_list_accessor('link' => 'XML::Atom::Link', 'links');
__PACKAGE__->mk_object_list_accessor('category' => 'XML::Atom::Category', 'categories');
__PACKAGE__->mk_object_list_accessor('author' => 'XML::Atom::Person', 'authors');
__PACKAGE__->mk_object_list_accessor('contributor' => 'XML::Atom::Person', 'contributors');

__PACKAGE__->_rename_elements('copyright' => 'rights');

# 0.3 -> 1.0 elements aliasing
sub _rename_elements {
    my($class, $atom03, $atom10) = @_;
    no strict 'refs';
    *{"$class\::$atom03"} = sub {
        my $self = shift;
        if ($self->version eq "1.0") {
            return $self->$atom10(@_);
        }
        @_ > 0 ? $self->set($self->ns, $atom03, @_) : $self->get($self->ns, $atom03);
    };

    *{"$class\::$atom10"} = sub {
        my $self = shift;
        if ($self->version eq "0.3") {
            return $self->$atom03(@_);
        }
        @_ > 0 ? $self->set($self->ns, $atom10, @_) : $self->get($self->ns, $atom10);
    };
}

1;