BabelObjects::Util::Facility::XMLFacility - manipulates XML data in an easy way


BabelObjects documentation Contained in the BabelObjects distribution.

Index


Code Index:

NAME

Top

BabelObjects::Util::Facility::XMLFacility - manipulates XML data in an easy way

SYNOPSIS

Top

  use BabelObjects::Util::Facility::XMLFacility;

  XML routines to help XML data manipulation. DON'T USE THIS PACKAGE ANYMORE.
  Use Xpath instead.

DESCRIPTION

Top

  XML routines to help XML data manipulation. DON'T USE THIS PACKAGE ANYMORE.
  Use Xpath instead.

AUTHOR

Top

Jean-Christophe Kermagoret, jck@BabelObjects.Org (http://www.BabelObjects.Org)

SEE ALSO

Top

perl(1).


BabelObjects documentation Contained in the BabelObjects distribution.

#/*====================================================================
# * Babel Objects, Version 1.0
# * ====================================================================
# *
# * Copyright (c) 2000 The Babel Objects Network. All rights reserved.
# *
# * This source file is subject to version 1.1 of The Babel Objects
# * License, that is bundled with this package in the file LICENSE,
# * and is available through the world wide web at :
# *
# *          http://www.BabelObjects.Org/law/license/1.1.txt
# *
# * If you did not receive a copy of the Babel Objects license and are
# * unable to obtain it through the world wide web, please send a note
# * to license@BabelObjects.Org so we can mail you a copy immediately.
# *
# * --------------------------------------------------------------------
# *
# * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
# * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# * DISCLAIMED.  IN NO EVENT SHALL THE BABEL OBJECTS NETWORK OR
# * ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
# * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
# * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# * SUCH DAMAGE.
# *
# * ====================================================================
# *
# * This software consists of voluntary contributions made by many
# * individuals on behalf of The Babel Objects Network.  For more
# * information on The Babel Objects Network, please see
# * <http://www.BabelObjects.org/>.
# *
# */

package BabelObjects::Util::Facility::XMLFacility;

use BabelObjects::Util::Dvlpt::Log;
use XML::DOM;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
	
);
$VERSION = '1.00';

my $aLog;

sub new {
    my $proto = shift;
    my $args = shift;

    my $class = ref($proto) || $proto;

    my $self  = {
    };

    bless ($self, $class);

    $aLog = new BabelObjects::Util::Dvlpt::Log();
    #$aLog->log("\n-- BabelObjects::Util::Facility::XMLFacility --");

    return $self;
}

sub getValueByPath {
    my $self = shift;
    my $node = shift;
    my $path = shift;

    $_ = $path;

    my (@tags) = /(.*)\/(.*)/;

    foreach (@tags) {
        #$aLog->log("Tag name to search : $_");
        $node = $self->getElementByTagName($node, $_);
    }

    return $node->getFirstChild->getData;
}

# return the first node under $node with the parameter named $name provided 
sub getElementByTagName {
    my $self = shift;
    my $node = shift;
    my $name = shift;

    #$aLog->log("getElementByTagName");
    #$aLog->log("    Node = $node");
    #$aLog->log("    Name = $name");

    my $nodes = $node->getElementsByTagName ("*", 0);
    my $n = $nodes->getLength;

    for (my $i = 0; $i < $n; $i++) {
        my $aNode = $nodes->item($i);
        #$aLog->log("    Type = ".$aNode->getNodeType);
        if ($aNode->getNodeType == ELEMENT_NODE) {
            #$aLog->log("    Current Name = ".$aNode->getNodeName);
            if ($aNode->getNodeName eq $name) {
                #$aLog->log("    Name result = ".$aNode->getNodeName);
                return $aNode;
            } else {
                my $nodeResult = $self->getElementByTagName($aNode, $name);
                if ($nodeResult) {
                    return $nodeResult;
                }
            }
        }
    }
}

# returns all the child nodes in the same level under 'node' and named 'name'
sub getElementsByTagName {
    my $self = shift;
    my $node = shift;
    my $name = shift;

    my @nodes;

    #$aLog->log("getElementsByTagName");
    #$aLog->log("    Node = $node");
    #$aLog->log("    Name = $name");

    my $childs = $node->getChildNodes();
    my $n = $childs->getLength;

    for (my $i = 0; $i < $n; $i++) {
        my $aNode = $childs->item($i);
        #$aLog->log("Node $i = ".$aNode);
        if ($aNode->getNodeType == ELEMENT_NODE) {
            #$aLog->log("Current Name = ".$aNode->getNodeName);
            if ($aNode->getNodeName eq $name) {
                #$aLog->log("    Name result = ".$aNode->getNodeName);
                push(@nodes, $aNode);
            }
        }
    }

    return @nodes
}

# returns all the nodes named 'name' under the branch
sub getElementsByPath {
    my $self = shift;
    my $node = shift;
    my $path = shift;
    my $regExp = shift || "([^\/]+)\/[^\/]+\/([^\/]+)";

    #my (@tags) = $path =~ /([^\/]+)/g;
    my (@tags) = $path =~ /$regExp/g;
    my $name = pop(@tags);

    foreach (@tags) {
        #$aLog->log("Tag name to search : $_");
        $node = $self->getElementByTagName($node, $_);
    }

    #$aLog->log("    Tag name to search : $name");
    #return $self->getElementByTagName($node, $name);
    return $node->getElementsByTagName($name);
}

# prints the xml tree
sub dump {
    my $self = shift;
    my $node = shift;
    my $spaces = shift;

    my $nodes = $node->getElementsByTagName ("*", 0);
    my $n = $nodes->getLength;

    for (my $i = 0; $i < $n; $i++) {
        my $aNode = $nodes->item($i);
        #$aLog->log("    Node = $aNode");
        #$aLog->log("      Type = ".$aNode->getNodeType);
        #$aLog->log("      Name = ".$aNode->getNodeName);
        if ($aNode->getNodeType == ELEMENT_NODE) {
            print $spaces."<".$aNode->getNodeName.">\n";
            if ( ($aNode->getFirstChild)
                    && ($aNode->getFirstChild->getNodeType == TEXT_NODE)
                    && ($aNode->getFirstChild->getData ne "") ) {
                $_ = $aNode->getFirstChild->getData;
                s/\t*|\s*|\n//g;
                if ($_ ne "") {
                    print $spaces."    ".$_."\n";
                }
            }
            $self->dump($aNode, $spaces."    ");
            print $spaces."</".$aNode->getNodeName.">\n";
        }
    }
}

1;
__END__
# Below is the stub of documentation for your module. You better edit it!