<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;"># Copyright (c)  1999 Chang  Liu 
# All rights  reserved.  
#
# This program is  free software; you can redistribute  it and/or modify
# it under the same terms as Perl itself.


package XML::Node;

#use strict;
#use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);

=head1 NAME

XML::Node - Node-based XML parsing: an simplified interface to XML::Parser

=head1 SYNOPSIS

 use XML::Node;

 $xml_node = new XML::Node;
 $xml_node-&gt;register( $nodetype, $callback_type =&gt; \&amp;callback_function );
 $xml_node-&gt;register( $nodetype, $callback_type =&gt; \$variable );
    
 open(FOO, 'xmlgenerator |');
 $p3-&gt;parse(*FOO);
 close(FOO);

 $xml_node-&gt;parsefile( $xml_filename );

=head1 DESCRIPTION

If you are only interested in processing certain nodes in an XML file, this 
module can help you simplify your Perl scripts significantly.

The XML::Node module allows you to register callback functions or variables for 
any  XML node. If you register a call back function, it will be called when
the node of the type you specified are encountered. If you register a variable, 
the content of a XML node will be appended to that variable automatically. 

Subroutine register accepts both absolute and relative node registrations.

Here is an example of absolute path registration: 

 1. register("&gt;TestCase&gt;Name", "start" =&gt; \&amp;handle_TestCase_Name_start);

Here are examples of single node name registration:

 2. register( "Name", "start" =&gt; \&amp;handle_Name_start);
 3. register( "Name", "end"   =&gt; \&amp;handle_Name_end);
 4. register( "Name", "char"  =&gt; \&amp;handle_Name_char);

Here is an example of attribute registration:

 5. register("&gt;TestCase:Author", "attr" =&gt; \$testcase_author);

Abosolute path trigger condition is recommended because a "Name" tage could appear in different
places and stands for differe names. 

Example:

  1  &lt;Testcase&gt;
  2     &lt;Name&gt;Something&lt;/Name&gt;
  3     &lt;Oracle&gt;
  4         &lt;Name&gt;Something&lt;/Name&gt;
  5     &lt;/Oracle&gt;
  6  &lt;/Testcase&gt;

Statement 1 causes &amp;handle_TestCase_Name_start to be called when parsing Line 2. Statements 2,3,4 cause the three handler subroutines to be called when parsing both Line 2 and Line 4.

This module uses XML::Parser.

=head1 EXAMPLE

Examples "test.pl" and "parse_orders.pl" come with this perl module.

=head1 SEE ALSO

XML::Parser

=head1 NOTE

When you register a variable, XML::Node appends strings found to that variable. So please be sure to clear that variable before it is used again.

=head1 AUTHORS

Chang Liu &lt;liu@ics.uci.edu&gt;

=head1 LAST MODIFIED

$Date: 2001/12/10 11:38:28 $

=cut


use Exporter;
$VERSION = "0.11";
@ISA = ('Exporter');
@EXPORT = qw (&amp;register &amp;parse &amp;parsefile);


use XML::Parser;
use Carp;


if ($ENV{DEBUG}) {
    print "DEBUG:XML::Node.pm VERSION $VERSION\n";
}

my $instance = 0;
my @selves = ();
my $myinstance;

sub new{
    my $class = shift;
    
    my $self = {
	INSTANCE       =&gt; $instance,
	START_HANDLERS =&gt; {},
	END_HANDLERS   =&gt; {},
	CHAR_HANDLERS  =&gt; {},
       	ATTR_HANDLERS  =&gt; {},
	CURRENT_TAG    =&gt; "",
	CURRENT_PATH   =&gt; "",
    };
    bless $self, $class;
    $selves[$instance++] = $self;
    return $self;
}

sub register
{
    $self = shift or croak "XML::Node --self is expected as THE first parameter \&amp;register.\n";
    my $node = shift or croak "XML::Node --a node path is expected as arg1 in \&amp;register.\n";
    my $type = shift or croak "XML::Node --node type is expected as arg2 in \&amp;register.\n";
    my $handler = shift or croak "XML::Node --a handler is expected as arg3 in \&amp;register.\n";
    if ($type eq "start") {
	$self-&gt;{START_HANDLERS}-&gt;{$node} = $handler;
    } elsif ($type eq "end") {
	$self-&gt;{END_HANDLERS}-&gt;{$node} = $handler;
    } elsif ($type eq "char") { 
	$self-&gt;{CHAR_HANDLERS}-&gt;{$node} = $handler;
    } elsif ($type eq "attr") { 
	$self-&gt;{ATTR_HANDLERS}-&gt;{$node} = $handler;
    } else {
	croak "XML::Node --unknown handler type $type for node $node\n";
    }
}


sub parsefile
{
    $self = shift or croak "XML::Node --self is expected as THE first parameter \&amp;register.\n";
    my $xml_file = shift or croak "XML::Node --an XML filename is expected in \&amp;parse.\n";

    $myinstance = $self-&gt;{INSTANCE};
    carp "XML::Node - invoking parser [$myinstance]" if $ENV{DEBUG};

my $my_handlers = qq {
sub handle_start_$myinstance
{
    &amp;handle_start($myinstance, \@_);
}
sub handle_end_$myinstance
{
    &amp;handle_end($myinstance, \@_);
}
sub handle_char_$myinstance
{
    &amp;handle_char($myinstance, \@_);
}
\$XML::Node::parser = new XML::Parser(Handlers =&gt; { Start =&gt; \\&amp; handle_start_$myinstance,
					End =&gt;   \\&amp; handle_end_$myinstance,
					Char =&gt;  \\&amp; handle_char_$myinstance } );

};
   #carp "[[[[[[[[[[[[[[[[$my_handlers]]]]]]]]]]]]]]";
    eval ($my_handlers);
    $parser-&gt;parsefile("$xml_file");
}

sub parse
{
    $self = shift or croak "XML::Node --self is expected as THE first parameter \&amp;register.\n";

    $myinstance = $self-&gt;{INSTANCE};
    carp "XML::Node - invoking parser [$myinstance]" if $ENV{DEBUG};

my $my_handlers = qq {
sub handle_start_$myinstance
{
    &amp;handle_start($myinstance, \@_);
}
sub handle_end_$myinstance
{
    &amp;handle_end($myinstance, \@_);
}
sub handle_char_$myinstance
{
    &amp;handle_char($myinstance, \@_);
}
\$XML::Node::parser = new XML::Parser(Handlers =&gt; { Start =&gt; \\&amp; handle_start_$myinstance,
					End =&gt;   \\&amp; handle_end_$myinstance,
					Char =&gt;  \\&amp; handle_char_$myinstance } );

};
   #carp "[[[[[[[[[[[[[[[[$my_handlers]]]]]]]]]]]]]]";
    eval ($my_handlers);
    $parser-&gt;parse(shift);
}

sub handle_start
{
    my $myinstance = shift;
    my $p = shift;
    my $element = shift;

    
    my $current_path = $selves[$myinstance]-&gt;{CURRENT_PATH} = 
    	$selves[$myinstance]-&gt;{CURRENT_PATH} . "&gt;" .  $element;
    my $current_tag = $selves[$myinstance]-&gt;{CURRENT_TAG} = $element;

    my $attr;
    my $value;

#    carp("handle_start called [$myinstance] [$element] [$current_path]\n");
    
    while (defined ($attr = shift ) ) {
	if (! defined ($value = shift)) {
	    croak ("value for attribute [$attr] of element [$element] is not returned by XML::Parser\n");
	}
#	carp("Attribute [$attr] of element [$element] found with value [$value] attr_path:[$attr_path]\n");
        my @array = split(/&gt;/, $current_path);
        my $current_relative_path = "$current_tag:$attr";
        my $i;
	if ($selves[$myinstance]-&gt;{ATTR_HANDLERS}-&gt;{$current_relative_path}) {
	    handle($p, $value, $selves[$myinstance]-&gt;{ATTR_HANDLERS}-&gt;{$current_relative_path});
	}
        for ($i=$#array-1;$i&gt;=1;$i--)
        { # call all relative paths 
    	    $current_relative_path = $array[$i] . "&gt;" . $current_relative_path;
  	    if ($selves[$myinstance]-&gt;{ATTR_HANDLERS}-&gt;{$current_relative_path}) {
	        handle($p, $value, $selves[$myinstance]-&gt;{ATTR_HANDLERS}-&gt;{$current_relative_path});
	    }
    	}
	my $attr_path = "$current_path:$attr";
	if ($selves[$myinstance]-&gt;{ATTR_HANDLERS}-&gt;{$attr_path}) {
	    handle($p, $value, $selves[$myinstance]-&gt;{ATTR_HANDLERS}-&gt;{$attr_path});
	}
    }

    my @array = split(/&gt;/, $current_path);
    my $current_relative_path = $current_tag;
    my $i;

    if ($selves[$myinstance]-&gt;{START_HANDLERS}-&gt;{$current_tag}) {
	handle($p, $element, $selves[$myinstance]-&gt;{START_HANDLERS}-&gt;{$current_tag});
    }
#carp("--Begin loop\n");
    for ($i=$#array-1;$i&gt;=1;$i--)
    { # call all relative paths 
	$current_relative_path = $array[$i] . "&gt;" . $current_relative_path;
#carp("Array size is $#array, \$i is $i, current_relative_path is $current_relative_path\n");
        if ($selves[$myinstance]-&gt;{START_HANDLERS}-&gt;{$current_relative_path}) {
    	    handle($p, $element, $selves[$myinstance]-&gt;{START_HANDLERS}-&gt;{$current_relative_path});
        }
    }
#carp("--End loop\n");
    if ($selves[$myinstance]-&gt;{START_HANDLERS}-&gt;{$current_path}) {
	handle($p, $element, $selves[$myinstance]-&gt;{START_HANDLERS}-&gt;{$current_path});
    }
}

sub handle_end
{
    my $myinstance = shift;
    my $p = shift;
    my $element = shift;
    my $current_path = $selves[$myinstance]-&gt;{CURRENT_PATH};

#    carp("handle_end called [$myinstance] [$element]\n");
    
    $selves[$myinstance]-&gt;{CURRENT_TAG} = $element;

    my @array = split(/&gt;/, $current_path);
    my $current_relative_path = $element;
    my $i;
    
    if ($selves[$myinstance]-&gt;{END_HANDLERS}-&gt;{$selves[$myinstance]-&gt;{CURRENT_TAG}}) {
	handle($p, $element, $selves[$myinstance]-&gt;{END_HANDLERS}-&gt;{$selves[$myinstance]-&gt;{CURRENT_TAG}});
    }
    for ($i=$#array-1;$i&gt;=1;$i--)
    { # call all relative paths 
	$current_relative_path = $array[$i] . "&gt;" . $current_relative_path;
#carp("Array size is $#array, \$i is $i, current_relative_path is $current_relative_path\n");
        if ($selves[$myinstance]-&gt;{END_HANDLERS}-&gt;{$current_relative_path}) {
    	    handle($p, $element, $selves[$myinstance]-&gt;{END_HANDLERS}-&gt;{$current_relative_path});
        }
    }
    if ($selves[$myinstance]-&gt;{END_HANDLERS}-&gt;{$selves[$myinstance]-&gt;{CURRENT_PATH}}) {
	handle($p, $element, $selves[$myinstance]-&gt;{END_HANDLERS}-&gt;{$selves[$myinstance]-&gt;{CURRENT_PATH}});
    } 
    
    $selves[$myinstance]-&gt;{CURRENT_PATH} =~ /(.*)&gt;/;
    $selves[$myinstance]-&gt;{CURRENT_PATH} = $1;
    $selves[$myinstance]-&gt;{CURRENT_TAG}  = $';
    if ($element ne $selves[$myinstance]-&gt;{CURRENT_TAG}) {
	carp "start-tag &lt;$selves[$myinstance]-&gt;{CURRENT_TAG}&gt; doesn't match end-tag &lt;$element&gt;. Is this XML file well-formed?\n";
    }
    $selves[$myinstance]-&gt;{CURRENT_PATH} =~ /(.*)&gt;/;
    $selves[$myinstance]-&gt;{CURRENT_TAG}  = $';
}

sub handle_char
{
    my $myinstance = shift;
    my $p = shift;
    my $element = shift;
    my $current_path = $selves[$myinstance]-&gt;{CURRENT_PATH};
    
#    carp("handle_char called [$myinstance] [$element]\n");

    my @array = split(/&gt;/, $current_path);
    my $current_relative_path = $element;
    my $i;

    if ($selves[$myinstance]-&gt;{CHAR_HANDLERS}-&gt;{$selves[$myinstance]-&gt;{CURRENT_TAG}}) {
	handle($p, $element, $selves[$myinstance]-&gt;{CHAR_HANDLERS}-&gt;{$selves[$myinstance]-&gt;{CURRENT_TAG}});
    }
    for ($i=$#array-1;$i&gt;=1;$i--)
    { # call all relative paths 
	$current_relative_path = $array[$i] . "&gt;" . $current_relative_path;
        if ($selves[$myinstance]-&gt;{CHAR_HANDLERS}-&gt;{$current_relative_path}) {
    	    handle($p, $element, $selves[$myinstance]-&gt;{CHAR_HANDLERS}-&gt;{$current_relative_path});
        }
    }
    if ($selves[$myinstance]-&gt;{CHAR_HANDLERS}-&gt;{$selves[$myinstance]-&gt;{CURRENT_PATH}}) {
	handle($p, $element, $selves[$myinstance]-&gt;{CHAR_HANDLERS}-&gt;{$selves[$myinstance]-&gt;{CURRENT_PATH}});
    }
}

sub handle
{
    my $p = shift;
    my $element = shift;
    my $handler = shift;

    my $handler_type = ref($handler);
    if ($handler_type eq "CODE") {
	&amp;$handler($p,$element);  # call the handler function
    } elsif ($handler_type eq "SCALAR")  {
#	chomp($element);
#	$element =~ /^(\s*)/;
#	$element = $';
#	$element =~ /(\s*)$/;
#	$element = $`;
	if (! defined $$handler) {
	    $$handler = "";
	    #carp ("XML::Node - SCALAR handler undefined when processing [$element]");
	}
	$$handler = $$handler . $element;  #append the content to the handler variable
    } else {
	carp "XML::Node -unknown handler type [$handler_type]\n";
	exit;
    }
}


1;
</pre></body></html>