File Coverage

blib/lib/XML/RSS/Parser/Element.pm

Criterion	Covered	Total	%
statement	50	74	67.5
branch	11	22	50.0
condition	5	12	41.6
subroutine	10	15	66.6
pod	10	10	100.0
total	86	133	64.6

package XML::RSS::Parser::Element;

use strict;
use base qw(XML::Elemental::Element);

use XML::Elemental::Util qw(process_name);
use XML::RSS::Parser::Util;

use Class::XPath 1.4
  get_name       => 'qname',
  get_parent     => 'parent',
  get_root       => 'root',
  get_children   => sub { $_[0]->contents ? @{$_[0]->contents} : () },
  get_attr_names => 'attribute_qnames',
  get_attr_value => 'attribute_by_qname',
  get_content    => 'text_content';

sub new {
    my $self = shift->SUPER::new(@_);
    my $a = shift || {};
    map { $self->{$_} = $a->{$_} }
      grep { defined $a->{$_} } qw( name attributes root parent );
    $self;
}

sub as_xml { XML::RSS::Parser::Util::as_xml($_[0]); }

#--- xpath methods

sub query {
    my @nodes = $_[0]->match($_[1]);
    wantarray ? @nodes : $nodes[0];
}

sub qname {
    my $in = $_[1] || $_[0]->name;
    my ($local, $ns) = process_name($in);
    return $local if ($_[0]->root->rss_namespace_uri eq $ns);
    my $prefix = XML::RSS::Parser->prefix($ns);
    unless ($prefix) {    # make a generic prefix for unknown namespace URI.
        my $i = 1;
        while (XML::RSS::Parser->namespace("NS$i")) { $i++ }
        XML::RSS::Parser->register_ns_prefix("NS$i", $ns);
        $prefix                                 = "NS$i";
    }
    "$prefix:$local";
}

sub attribute_qnames {
    return () unless my $attr = $_[0]->attributes;
    my ($foo, $ns) = process_name($_[0]->name);
    my @names;
    foreach (keys %$attr) {
        my ($local, $nsa) = process_name($_);
        $nsa ||= $ns;
        push @names, $_[0]->qname("{$nsa}$local");
    }
    @names;
}

my $NAME = qr/[[:alpha:]_][\w\-\.]*/;

sub attribute_by_qname {
    my $self = shift;
    my $name = shift;
    my $ns   = '';
    if ($name =~ /($NAME):($NAME)/) {
        $name = $2;
        $ns = XML::RSS::Parser->namespace($1) || '#UNKNOWN';
    } else {
        $ns = XML::RSS::Parser->namespace('#DEFAULT') || '';
    }
    my ($local, $ns_parent) = process_name($self->name);
    $ns = '' if $ns_parent eq $ns;
    $self->attributes->{"{$ns}$name"};
}

#--- XML::RSS::Parser::Element 2x API methods. Now deprecated.

sub child {
    my ($self, $tag) = @_;
    my $class = ref($self);
    my $e = $class->new({parent => $self, name => $tag});
    push(@{$self->contents}, $e);
    $e;
}

sub children {
    my ($self, $name) = @_;
    return $self->contents unless defined($name);
    my @c = grep { $_->can('name') && $_->name eq $name } @{$self->contents};
    wantarray ? @c : $c[0];
}

sub attribute {
    $_[0]->attributes->{$_[1]} = $_[2] if $_[2];
    $_[0]->attributes->{$_[1]};
}

sub children_names {
    my $class = ref($_[0]);
    map { $_->name } grep { ref($_) eq $class } @{$_[0]->contents};
}

# previously deprecated methods value and append_value have been removed.

1;

__END__