File Coverage

blib/lib/XML/SimpleObject/LibXML.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package XML::SimpleObject::LibXML;

use strict;
use XML::LibXML 1.53;
use XML::LibXML::Common;

our $VERSION = '0.60';

sub attributes {
    my $self = shift;
    my $name = shift;
    my %attributes;
    my @attrs = $self->{_DOM}->getAttributes;
    foreach my $attribute (@attrs) {
        $attributes{$attribute->getName} = $attribute->value;
    }
    return %attributes;
}

sub attribute {
    my $self = shift;
    my $name = shift;
    my $newvalue = shift;
    if ($self->hasNamespaces()) {
      my ($namespaceURI, $localName) = $self->_parseTagName($name, ATTRIBUTE_NODE);

      if (defined($namespaceURI)) { # Attribute has an explicit namespace
         my ($found) = $self->{_DOM}->getAttributeNodeNS($namespaceURI, $localName);
         if ($found) {
           if ($newvalue) {
             $found->setValue($newvalue);
           } else {
             return $found->value;
           }
         }
      } else {                      # Attribute has no namespace
            my ($found) = $self->{_DOM}->getAttributeNode($name);
            if ($found) {
              if ($newvalue) {
                $found->setValue($newvalue);
              } else {
                return $found->value;
              }
            }
      }

    } else {
      my ($found) = $self->{_DOM}->findnodes("\@$name");
      if ($found) {
        if ($newvalue) {
          $found->setValue($newvalue);
        } else {
          return $found->value;
        }
      }
    }
}

sub add_attribute {
    my $self = shift;
    $self->{_DOM}->setAttribute( $_[0], $_[1] );
    return $self;
}

sub value {
    my $node = shift;
    my $newvalue = shift;
    my ($found) = $node->{_DOM}->findnodes("text()");
    if ($found) {
        if (defined $newvalue) {
          return $found->setData($newvalue);
        } else {
          return $found->getData();
        }
    }
}

sub name {
    my $node = shift;
    my $newname = shift;
    if ($newname) {
      $node->{_DOM}->setNodeName($newname);
    } else {
      $node->{_DOM}->getName;
    }
}

sub type {
  $_[0]->{_DOM}->nodeType;
}

sub xpath_search {
  my $self = shift;
  my $xpath = shift;
  my @nodes;
  foreach my $node ($self->{_DOM}->findnodes($xpath)) {
    my $newobj = new XML::SimpleObject::LibXML ($node);
    return $newobj unless wantarray;
    push @nodes, $newobj;
  }
  return @nodes;
}

sub namespaceURI() {
  $_[0]->{_DOM}->getNamespaceURI();
}

sub namespace() {
  my $node = shift;
  my $namespaceURI = $node->namespaceURI();

  return unless (defined $namespaceURI);

  my (@found) = $node->{_DOM}->findnodes("namespace::*"); for (@found) {
    return $_->getLocalName() if $namespaceURI eq $_->getData();
  }
}

sub hasNamespaces() {
  return $_[0]->{_NAMESPACES};
}

sub _parseTagName($$) {
    my ($self, $tag, $type) = @_;

    my ($namespaceURI, $localName);

    if ($tag =~ /^([^:]+):(.*)/) {
        # Tag has an explicit namespace
        $namespaceURI = $self->{_NAMESPACES}->{$1};
        $localName = $2;
        die("Unknown namespace $1") unless ($namespaceURI);
    }
    else {
        $localName = $tag;
        # Tag has no explicit namespace.
        if ($type eq ELEMENT_NODE) {
            # Elements live in the default namespace.
            # Go with the default namespace.  If one was specified, it will be ''.
            $namespaceURI = $self->{_NAMESPACES}->{''};
        }
        elsif ($type eq ATTRIBUTE_NODE) {
            # The default namespace does not apply to attribute names.
            # (See http://www.w3.org/TR/1998/PR-xml-names-19981117, section 5.3)
        }
        else {
            # Nothing else has tagnames.
            die("Unexpected type $type");
        }
    }

    return ($namespaceURI, $localName);
}

sub child {
    my $self = shift;
    my $tag  = shift;
    if (ref $self->{_DOM} eq "XML::LibXML::Document") {
        my $node = new XML::SimpleObject::LibXML ($self->{_DOM}->documentElement());
        return $node;
    }
    elsif ($self->hasNamespaces()) {
        my ($namespaceURI, $localName) = $self->_parseTagName($tag, ELEMENT_NODE);
        my ($element) = $self->{_DOM}->getElementsByTagNameNS($namespaceURI, $localName);
        return unless ($element);
        my $node = new XML::SimpleObject::LibXML ($element);
        return $node;
    }
    else
    {
        my ($element) = $self->{_DOM}->getElementsByTagName($tag);
        return unless ($element);
        my $node = new XML::SimpleObject::LibXML ($element);
        return $node;
    }
}

sub add_child {
    my $self = shift;
    my $element = $self->{_DOM}->addNewChild( undef, $_[0]);
    if ($_[1]) {
       $element->appendTextNode($_[1]);
    }
    my $node = new XML::SimpleObject::LibXML ($element);
    return $node;
}

sub delete {
    my $self = shift;
    $self->{_DOM}->unbindNode;
}

sub children_names {
    my $self = shift;
    my @elements;
    foreach my $node ($self->{_DOM}->getChildnodes)
    {
        next if ($node->nodeType == 3);
        push @elements, $node->getName;
    }
    return @elements;
}

sub children {
    my $self = shift;
    my $tag  = shift;
    if (ref $self->{_DOM} eq "XML::LibXML::Document") {
        my $node = new XML::SimpleObject::LibXML ($self->{_DOM}->documentElement());
        return $node;
    }
    elsif (defined($tag)) { # tag: return matching children
        if ($self->hasNamespaces()) {
            my ($namespaceURI, $localName) = $self->_parseTagName($tag, ELEMENT_NODE);
            my @nodelist;
            foreach my $node ($self->{_DOM}->getElementsByTagNameNS($namespaceURI, $localName)) {
                next if ($node->nodeType == TEXT_NODE);
                push @nodelist, new XML::SimpleObject::LibXML ($node);
            }
            return @nodelist;
        }
        else {
            my @nodelist;
            foreach my $node ($self->{_DOM}->getElementsByTagName($tag)) {
                next if ($node->nodeType == TEXT_NODE);
                push @nodelist, new XML::SimpleObject::LibXML ($node);
            }
            return @nodelist;
        }
    }
    else # no tag: return all children
    {
        my @nodelist;
        foreach my $node ($self->{_DOM}->getChildnodes()) {
            next if ($node->nodeType == 3);
            push @nodelist, new XML::SimpleObject::LibXML ($node);
        }
        return @nodelist;
    }
}

sub output_xml {
    my $self = shift;
    my %args = @_;
    return $self->{_DOM}->toString($args{indent},$args{original_encoding});
}

sub output_xml_file {
    my $self = shift;
    my %args = @_;
    open FILE, ">" . $args{file} or die $!;
    print FILE $self->output_xml(%args);
    close FILE;
}

sub replace_names_values {
  my $self = shift;
  my %args = @_;
  foreach my $node ($self->{_DOM}->findnodes($args{xpath})) {
    $args{name} && do { $node->setNodeName($args{name}) };
    my $nodetype = $node->nodeType;
    if ($nodetype == 1) {      # Element, try text node
      $args{value} && do {
        my ($found) = $node->findnodes("text()");
        $found->setData($args{value});
      };
    } elsif ($nodetype == 2) { # Attribute
      $args{value} && do { $node->setValue($args{value}) };
    } elsif ($nodetype == 3) { # Text
      $node->setData($args{value});
    }
  }
}

sub delete_nodes {
  my $self = shift;
  my %args = @_;
  foreach my $node ($self->{_DOM}->findnodes($args{xpath})) {
    $node->unbindNode();
  }
}

sub _build_namespace_map() {
    my $self = shift;
    return if $self->{_NAMESPACES};

    my %map = map { my $key = $_->getLocalName(); $key = '' unless defined $key; $key  => $_->getData() } $self->{_DOM}->findnodes("namespace::*");
    $self->{_NAMESPACES} = \%map if (scalar(%map));
}

sub _init() {
    my $self = shift;
    $self->_build_namespace_map();
}

sub new {
    my $class = shift;
    if (ref($_[0]) =~ /^XML\:\:LibXML/) {
        my $self = {};
        bless ($self,$class);
        $self->{_DOM}  = $_[0];
        $self->_init();
        return $self;
    } else {
        my %args   = @_;
        my $parser = new XML::LibXML;
        my $dom;
        if ($args{XML}) {
          $dom  = $parser->parse_string($args{XML});
        } elsif ($args{file}) {
          $dom = $parser->parse_file($args{file});
        } else {
          die "new() not called with DOM, XML string, or filename";
        }
        my $self   = {};
        bless ($self,$class);
        $self->{_NAME} = "";
        $self->{_DOM}  = $dom;
        $self->_init();
        return $self;
    }
}


1;
__END__