source: A2P/a2p/A2P/EService/SimpleXML.pm @ 3

#
# Copyright (c) 2004-2007 - Consultas, PKG.fr
#
# This file is part of A2P.
#
# A2P is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# A2P is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with A2P; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
#
# $Id: SimpleXML.pm 3 2007-10-18 16:20:19Z guillaume $
#

package A2P::EService::SimpleXML ;

# API to handle XML format

use strict ;
use XML::LibXML ;
use A2P::EService::Tools qw( abort ) ;

BEGIN {
    our $VERSION = sprintf "%s", q$Rev: 836 $ =~ /(\d[0-9.]+)\s+/ ;
}
our $VERSION ;

sub new {
    my $class = shift ;

    my $parser = new XML::LibXML ;
    abort "Unable to get an XML parser" unless (defined($parser));

    my $self = {
        PARSER => $parser,
        NODES  => {}
    };

    bless $self, $class ;

    # Still a file if called with an argument
    $self->loadfile($_[0]) if @_ ;

    return $self ;
}

sub loadfile {
    my $self = shift ;
    my $file = shift or abort "No XML file given to load" ;

    abort "Bad XMLfile found" unless -s $file ;

    my $xml = $self->{PARSER}->parse_file( $file );
    abort "Can't parse '$file' as XML" unless (defined($xml));

    # Keep trace of encoding
    $self->{ENCODING} = lc( $xml->encoding() || '' );

    my $root = $xml->lastChild ;
    abort "No XML root found in file" unless (defined($root));

    return $self->{ROOT} = $root ;
}

sub encoding {
    my $self = shift ;
    return defined($self->{ENCODING}) ? $self->{ENCODING} : '' ;
}

sub root {
    my $self = shift ;
    return defined($self->{ROOT}) ? $self->{ROOT} : '' ;
}

sub name {
    my $root = $_[0]->root ;
    return $root ? $root->nodeName : '' ;
}

sub attribut {
    my $root = $_[0]->root ;
    my $name = $_[1] or return '' ;
    return $root ? $root->getAttribute($name) : '' ;
}

sub content {
    my $self = shift ;
    my $root = $self->root ;
    my $content = $root ? $root->textContent : '' ;

    # Strip first empty lines due to XML format
    ( $content ) = $content =~ /^\n*(.*)$/ms if $content ;

    return $content ;
}

sub nodes {
    my $self = shift ;
    my $name = shift or return () ;
    my $filter = shift || {} ;

    my %attrib = () ;
    while (@_) {
        my $attribut = shift ;
        $attrib{$attribut} = "" ;
    }

    # Control attribut filter is a hash list
    $filter = {} unless (ref($filter) =~ /^HASH/i);

    # Use cached nodes if still passed here
    my @nodes ;
    if ( exists($self->{NODES}->{$name})
    and ref($self->{NODES}->{$name}) =~ /^ARRAY/i ) {
        @nodes = @{$self->{NODES}->{$name}} ;

    } else {
        my $root ;
        # Return no node value if root is not available
        return () unless ( $root = $self->root );

        # Get nodes
        @nodes = $root->getChildrenByTagName($name);

        # Unbind nodes to skip retreiving their content in the body
        map { $_->unbindNode } @nodes ;

        # Keep the list in cache
        $self->{NODES}->{$name} = \@nodes ;
    }

    my @values = () ;
    foreach my $node ( @nodes ) {
        # Check if this node is to return
        my $filtered = 0 ;
        foreach my $key (keys(%{$filter})) {
            $filtered ++ ;
            my $match = $filter->{$key} ;
            my $value = $node->getAttribute($key) || "" ;
            next unless ( $value =~ /^$match$/ );
            $filtered = 0 ;
            last ;
        }
        next if $filtered ;

        my $found = 0 ;
        foreach my $attribut (keys(%attrib)) {
            my $value = $node->getAttribute($attribut) || "" ;
            next unless ($value);
            $found ++ ;
            $attrib{$attribut} = $value ;
        }

        my $content = $node->textContent || "" ;
        push @values, $found ? [ $content, \%attrib ] : $content ;
    }

    return @values ;
}

1;