### Local Variables: ***
### mode:perl ***
### comment-column:0 ***
### comment-start: "### " ***
### comment-end: "***" ***
### End: ***
#
# ****************DO NOT MOVE OR CHANGE LINES ABOVE THIS*********************
#
# The first set of lines runs perl from any shell. The second set of lines
# identifies the rest of the file as PERL for EMACS autoformatting.
# See end of copyright for more information.
#
#
# -------------------------------------------------------------------
# X-BONE
#
# http://www.isi.edu/xbone
# USC Information Sciences Institute (USC/ISI)
# Marina del Rey, California 90292, USA
# Copyright (c) 1998-2005
#
# -------------------------------------------------------------------
#
# Copyright (c) 1998-2005 by the University of Southern California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and
# its documentation in source and binary forms for non-commercial
# purposes and without fee is hereby granted, provided that the above
# copyright notice appear in all copies and that both the copyright
# notice and this permission notice appear in supporting
# documentation, and that any documentation, advertising materials,
# and other materials related to such distribution and use acknowledge
# that the software was developed by the University of Southern
# California, Information Sciences Institute. The name of the
# University may not be used to endorse or promote products derived
# from this software without specific prior written permission.
#
# THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT
# THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE. THIS SOFTWARE IS
# PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# Other copyrights might apply to parts of this software and are so
# noted when applicable.
#
# -------------------------------------------------------------------
#
# Effort partly sponsored by the Defense Advanced Research Projects
# Agency (DARPA) and Air Force Research Laboratory, Air Force Materiel
# Command, USAF, under agreement numbers F30602-98-1-0200 (X-Bone) and
# F30602-01-2-0529 (DynaBone). The views and conclusions contained
# herein are those of the authors and should not be interpreted as
# necessarily representing the official policies or endorsements,
# either expressed or implied, of the Defense Advanced Research
# Projects Agency (DARPA), the Air Force Research Laboratory, or the
# U.S. Government.
#
# This work was partly supported by the NSF STI-XTEND (ANI-0230789)
# and NETFS (ANI-0129689) projects. Any opinions, findings, and
# conclusions or recommendations expressed in this material are those
# of the authors and do not necessarily reflect the views of the
# National Science Foundation.
#
# -------------------------------------------------------------------
##################################################
#
#
# XBone XML scanning utilities used by GUI and OM
#
# Principal author: Gregory G. Finn
#
#
# These routines presume that the GNOME package libxml2, which is a C language
# based XML parser library has been installed on the running system. The
# Perl package XML::LibXML requires libxml2.
#
# The Perl packages XML::LibXML and XML::Simple must be installed
# on the running system. XML::LibXML also requires installation of:
#
# XML::LibXML::Common
# XML::NamespaceSupport
# XML::NodeFilter
# and perhaps XML::SAX
#
# in order to ensure the XML::LibXML passes its installation test suite.
#
##################################################
package XB_XML_scan;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw();
use strict;
use Data::Dumper;
use XML::LibXML;
use XML::Simple;
use FindBin qw($Bin);
use LWP::Simple;
##############################################################################
#
# sub XB_XML_parse ( xmlref )
#
# Parses the XML string referenced by xmlref. The XML string should include
# a reference to the DTD file SYSTEM "api.dtd", which is located in the same
# directory as XB_XML.pm.
#
# Returns an empty string "" if the parse succeeds. Otherwise, the error
# string is returned.
##############################################################################
###################################################
# Next four functions are callbacks from the parse.
###################################################
###################################################
# the parser is asking us if the URI is of interest
# to us.
###################################################
sub match_uri {
my $uri = shift;
return ($uri =~ /xbone/i);
}
###################################################
# capture the URL (http://.../api*.dtd) that is contained in the
# XML string when the parser tries to open it. Extract the
# filename to see if a local copy exists and if not if a copy
# can be made of the file. once the file or local copy
# is available, then open it and return the handle.
###################################################
sub open_uri {
my $uri = shift;
my $file = "";
my $dir = $Bin;
# figure of the local file name
if ($uri =~ /([^\/]+$)/){
$file = $1;
} else {
die ("Cannot find the DTD resource necessary");
};
# figure out if there is a copy already somewhere
my $found =0;
foreach my $path ("$dir/modules/",# node daemon
"$dir/../lib", # GUI code
"/usr/local/etc/xbone", #default if nothing works
"/usr/local/xbone/programs/modules",
"/tmp"){
if (-e $path and -e "$path/$file" and -r "$path/$file"){
$file = "$path/$file";
$found = 1;
last;
};
}
if (! $found) {
# No copy. make a local copy of the file. worst case a temp
# file can be created. in most cases it should not come here.
# note the change in order of the paths
foreach my $path ("/usr/local/etc/xbone",
"/usr/local/xbone/programs/modules",
"$dir/modules/",
"$dir/../lib",
"/tmp"
){
if (-e $path and -w $path){
$file = "$path/$file";
if (not head($uri)){
# does this exist?
die ("XML resource $uri does not exist. " .
"Please mail xbone\@isi.edu");
}
mirror($uri, $file);
$found = 1;
last;
}
};
}
die "Cannot access local resource $uri" if (!$found);
# open this cached copy and return it to the library.
my $URI;
open $URI, $file or die "Error while accessing local resource $file";
return $URI;
}
###################################################
# the parser is asking us to read the file. This
# is presumably if we want to do some processing
# e.g., decompression. We dont have do anything.
###################################################
sub read_uri {
my $handler = shift;
my $length = shift;
my $buffer;
read($handler, $buffer, $length);
return $buffer;
}
###################################################
# close the file. DTD has been read by now.
###################################################
sub close_uri {
my $handler = shift;
close($handler);
}
sub XB_XML_parse ($)
{
my ($xmlref) = @_;
my $result = "";
my $parser = undef;
eval {
$parser = XML::LibXML->new;
# => register the callbacks so that we can
# transparently redirect them to the local
# copy.
$parser->match_callback(\&match_uri);
$parser->open_callback(\&open_uri);
$parser->read_callback(\&read_uri);
$parser->close_callback(\&close_uri);
$parser->validation(1);
$parser->pedantic_parser(1);
$parser->load_ext_dtd(1);
$parser->expand_entities(1);
$parser->complete_attributes(1);
#$parser->recover(1);
#$parser->enable_linenumbers(1);
$parser->parse_string($$xmlref);
};
if ($@){
$result = $@;
};
return $result;
}
##############################################################################
#
# sub XB_XML_hash ( xmlref )
#
# Uses XML::Simple to create a hash of the XML string referenced by xmlref.
# xmlref must point to a well-formed XML string.
#
# Returns a reference to the hash representing the XML structure.
##############################################################################
sub XB_XML_hash ($)
{
my ($xmlref) = @_;
my $simple;
$simple = new XML::Simple (RootName => 'xbone');
return ($simple->XMLin($$xmlref));
}
##############################################################################
#
# sub XB_XOL_xbone_list_sub ( xbhref )
#
# xbhref is a reference to the hash of an xbone element returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# To make an xbone hash consistent, all elements that can appear under it more
# than once in sequence are placed inside lists.
##############################################################################
sub XB_XOL_xbone_list_sub ($)
{
my ($xbhref) = @_;
my ($cmdhref, $pcmdhref, $crhref);
$crhref = $xbhref->{'credential'}; # substitute for credential element
XB_XOL_property_list_sub ($crhref);
$cmdhref = $xbhref->{'command'};
if (defined ($pcmdhref = $cmdhref->{'create_overlay_reply'}))
{ XB_XOL_createovl_reply_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'create_overlay'}))
{ XB_XOL_createovl_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'list_overlays_reply'}))
{ XB_XOL_listovls_reply_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'list_overlays'}))
{ XB_XOL_listovls_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'overlay_status_reply'}))
{ XB_XOL_ovlstatus_reply_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'overlay_status'}))
{ XB_XOL_ovlstatus_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'discover_daemons_reply'}))
{ XB_XOL_discdaemons_reply_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'discover_daemons'}))
{ XB_XOL_discdaemons_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'destroy_overlay_reply'}))
{ XB_XOL_destroyovl_reply_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'destroy_overlay'}))
{ XB_XOL_destroyovl_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'destroyall_overlays_reply'}))
{ XB_XOL_destroyallovls_reply_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'destroyall_overlays'}))
{ XB_XOL_destroyallovls_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'host_choices_reply'}))
{ XB_XOL_hstchoices_reply_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'host_choices'}))
{ XB_XOL_hstchoices_list_sub ($pcmdhref); }
elsif (defined ($pcmdhref = $cmdhref->{'error_reply'}))
{ XB_XOL_error_reply_list_sub ($pcmdhref); }
else { die ("Unknown Xbone command"); };
};
##############################################################################
#
# sub XB_XOL_property_list_sub ( parenthref )
#
# parenthref is a reference to the hash of an element returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# The data structure returned by XML::Simple is altered so that any property
# element is represented as a Perl hash, with any property* or property+
# multiples gathered into a single Perl hash.
##############################################################################
sub XB_XOL_property_list_sub ($)
{
my ($parenthref) = @_;
my ($propref);
if (defined ($propref = $parenthref->{property}))
{
# if (ref ($propref) eq 'HASH')
# {
# $parenthref->{property} = [ $propref ]; # embed in anonymous list
# };
if (ref ($propref) eq 'ARRAY')
{
$parenthref->{property} = XB_XOL_collect_properties ($propref);
}
else
{
# singleton is not enclosed in list by XML::Simple
$parenthref->{property} = { $propref->{tag} => $propref->{value} };
};
};
};
##############################################################################
#
# sub XB_XOL_collect_properties ( lref )
#
# lref is a reference to the list of property elements returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# This routine collects all the property element prop and value attributes
# into one proplist (hash) and returns a reference to it.
##############################################################################
sub XB_XOL_collect_properties ($)
{
my ($lref) = @_;
my (%plhash, $pref) = ();
%plhash = ();
for $pref (@$lref)
{ $plhash{$pref->{tag}} = $pref->{value}; };
return (\%plhash);
};
##############################################################################
#
# sub XB_XOL_argstring_list_sub ( parenthref )
#
# parenthref is a reference to the hash of an argstring returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# To make this element hash consistent, any argstring+ or argstring* element
# it contains as a son is placed inside a list.
##############################################################################
sub XB_XOL_argstring_list_sub ($)
{
my ($parenthref) = @_;
my ($argref);
if (defined ($argref = $parenthref->{'argstring'}))
{
if (ref ($argref) eq 'HASH')
{
$parenthref->{'argstring'} = [ $argref ]; # embed in anonymous list
};
};
};
##############################################################################
#
# sub XB_XOL_createovl_reply_list_sub ( covlrhref )
#
# covlrhref is a reference to the hash of a create_overlay_reply element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that appear
# in series in a list of hashes, whereas if a single element occurs in isolation,
# it is represented as a single hash.
#
# To make a create_overlay_reply hash consistent, all elements that can appear more
# than once in sequence are placed inside lists. These elements are:
#
# property, node
#
##############################################################################
sub XB_XOL_createovl_reply_list_sub ($)
{
my ($covlrhref) = @_;
my ($nref, $nhref, $nlref);
XB_XOL_property_list_sub ($covlrhref); # substitute for any property element
if (defined ($nref = $covlrhref->{'node'})) # node is optional
{
if (ref ($nref) eq 'HASH')
{
$covlrhref->{'node'} = [ $nref ]; # embedded in anonymous list
};
$nlref = $covlrhref->{'node'};
foreach $nhref (@$nlref)
{ XB_XOL_node_list_sub ($nhref); }; # substitute in each vnode element
};
};
##############################################################################
#
# sub XB_XOL_createovl_list_sub ( covlhref )
#
# covlhref is a reference to the hash of a create_overlay element returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# To make a create_overlay hash consistent, all elements that can appear more than
# once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_createovl_list_sub ($)
{
my ($covlhref) = @_;
my ($xolhref);
XB_XOL_property_list_sub ($covlhref); # substitute for any property element
$xolhref = $covlhref->{'xol_program'}; # substitute into xol_program element
XB_XOL_program_list_sub ($xolhref);
};
##############################################################################
#
# sub XB_XOL_listovls_reply_list_sub ( lovlshref )
#
# lovlshref is a reference to the hash of a list_overlays_reply element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make a list_overlays_reply hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property, argstring
#
##############################################################################
sub XB_XOL_listovls_reply_list_sub ($)
{
my ($lovlshref) = @_;
XB_XOL_property_list_sub ($lovlshref); # substitute for any property element
XB_XOL_argstring_list_sub ($lovlshref); # substitute for any argstring element
};
##############################################################################
#
# sub XB_XOL_listovls_list_sub ( lovlshref )
#
# lovlshref is a reference to the hash of a list_overlays element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make a list_overlays hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_listovls_list_sub ($)
{
my ($lovlshref) = @_;
XB_XOL_property_list_sub ($lovlshref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_ovlstatus_reply_list_sub ( ovlshref )
#
# ovlshref is a reference to the hash of an overlay_status_reply element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make an overlay_status_reply hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property, node
#
##############################################################################
sub XB_XOL_ovlstatus_reply_list_sub ($)
{
my ($ovlshref) = @_;
my ($nref, $nhref, $nlref);
XB_XOL_property_list_sub ($ovlshref); # substitute for any property element
if (defined ($nref = $ovlshref->{'node'})) # node is optional
{
if (ref ($nref) eq 'HASH')
{
$ovlshref->{'node'} = [ $nref ]; # embedded in anonymous list
};
$nlref = $ovlshref->{'node'};
foreach $nhref (@$nlref)
{ XB_XOL_node_list_sub ($nhref); }; # substitute in each vnode element
};
};
##############################################################################
#
# sub XB_XOL_ovlstatus_list_sub ( ovlshref )
#
# ovlshref is a reference to the hash of a overlay_status element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make an overlay_status hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_ovlstatus_list_sub ($)
{
my ($ovlshref) = @_;
XB_XOL_property_list_sub ($ovlshref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_discdaemons_reply_list_sub ( ddshref )
#
# ddshref is a reference to the hash of a discover_daemons_reply element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make a discover_daemons_reply hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property, node
#
##############################################################################
sub XB_XOL_discdaemons_reply_list_sub ($)
{
my ($ddshref) = @_;
my ($nref, $nhref, $nlref);
XB_XOL_property_list_sub ($ddshref); # substitute for any property element
if (defined ($nref = $ddshref->{'node'})) # node is optional
{
if (ref ($nref) eq 'HASH')
{
$ddshref->{'node'} = [ $nref ]; # embedded in anonymous list
};
$nlref = $ddshref->{'node'};
foreach $nhref (@$nlref)
{ XB_XOL_node_list_sub ($nhref); }; # substitute in each vnode element
};
};
##############################################################################
#
# sub XB_XOL_discdaemons_list_sub ( ddshref )
#
# ddshref is a reference to the hash of a discover_daemons element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make a discover_daemons hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_discdaemons_list_sub ($)
{
my ($ddshref) = @_;
XB_XOL_property_list_sub ($ddshref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_destroyovl_reply_list_sub ( dovlhref )
#
# dovlhref is a reference to the hash of a destroy_overlay_reply element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make a destroy_overlay_reply hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_destroyovl_reply_list_sub ($)
{
my ($dovlhref) = @_;
XB_XOL_property_list_sub ($dovlhref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_destroyovl_list_sub ( dovlhref )
#
# dovlhref is a reference to the hash of a destroy_overlay element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make a destroy_overlay hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_destroyovl_list_sub ($)
{
my ($dovlhref) = @_;
XB_XOL_property_list_sub ($dovlhref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_destroyallovls_reply_list_sub ( dovlhref )
#
# dovlhref is a reference to the hash of a destroyall_overlays_reply element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make a destroyall_overlays_reply hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_destroyallovls_reply_list_sub ($)
{
my ($dovlhref) = @_;
XB_XOL_property_list_sub ($dovlhref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_destroyallovls_list_sub ( dovlhref )
#
# dovlhref is a reference to the hash of an deatroyall_overlays element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make a destroyall_overlays hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_destroyallovls_list_sub ($)
{
my ($dovlhref) = @_;
XB_XOL_property_list_sub ($dovlhref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_hstchoices_reply_list_sub ( hchref )
#
# hchref is a reference to the hash of a host_choices_reply element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make a host_choices_reply hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# node
#
##############################################################################
sub XB_XOL_hstchoices_reply_list_sub ($)
{
my ($hchref) = @_;
my ($nref, $nhref, $nlref);
if (defined ($nref = $hchref->{'node'})) # node is optional
{
if (ref ($nref) eq 'HASH')
{
$hchref->{'node'} = [ $nref ]; # embedded in anonymous list
};
$nlref = $hchref->{'node'};
foreach $nhref (@$nlref)
{ XB_XOL_node_list_sub ($nhref); }; # substitute in each vnode element
};
};
##############################################################################
#
# sub XB_XOL_hstchoices_list_sub ( hchref )
#
# hchref is a reference to the hash of a host_choices element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make a host_choices hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property, node
#
##############################################################################
sub XB_XOL_hstchoices_list_sub ($)
{
my ($hchref) = @_;
my ($nref, $nhref, $nlref);
XB_XOL_property_list_sub ($hchref); # substitute for any property element
if (defined ($nref = $hchref->{'node'})) # node is optional
{
if (ref ($nref) eq 'HASH')
{
$hchref->{'node'} = [ $nref ]; # embedded in anonymous list
};
$nlref = $hchref->{'node'};
foreach $nhref (@$nlref)
{ XB_XOL_node_list_sub ($nhref); }; # substitute in each vnode element
};
};
##############################################################################
#
# sub XB_XOL_error_reply_list_sub ( errhref )
#
# errhref is a reference to the hash of an error_reply element returned
# by XML::Simple. The XML::Simple parse encloses mutiples of an element that
# appear in series in a list of hashes, whereas if a single element occurs in
# isolation, it is represented as a single hash.
#
# To make an error_reply hash consistent, all elements that can appear
# more than once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_error_reply_list_sub ($)
{
my ($errhref) = @_;
XB_XOL_property_list_sub ($errhref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_program_list_sub ( xolhref )
#
# xolhref is a reference to the hash of a XOL_program element returned by
# XML::Simple. The XML::Simple parse encloses mutiples of an element that appear
# in series in a list of hashes, whereas if a single element occurs in isolation,
# it is represented as a single hash.
#
# To make the xolref hash consistent, all elements that can appear more than
# once in sequence are placed inside lists. These elements are:
#
# node_def, iface, link, property and define_prop
#
##############################################################################
sub XB_XOL_program_list_sub ($)
{
my ($xolref) = @_;
my ($ndref, $eqref, $ndlref, $ndhref, $eqlref, $eqhref);
###################################
# Perform substitution for node_def
# and define_prop elements
###################################
$ndref = $xolref->{'node_def'};
if (ref ($ndref) eq 'HASH')
{
$xolref->{'node_def'} = [ $ndref ]; # embedded in anonymous list
};
$ndlref = $xolref->{'node_def'};
foreach $ndhref (@$ndlref) # substitute in each node_def element
{ XB_XOL_nodedef_list_sub ($ndhref); };
if (defined ($eqref = $xolref->{'define_prop'})) # define_prop is optional
{
if (ref ($eqref) eq 'HASH')
{
$xolref->{'define_prop'} = [ $eqref ]; # embedded in anonymous list
};
# We do not substitute into define_prop elements as the property
# elements there must appear once only.
};
};
##############################################################################
#
# sub XB_XOL_nodedef_list_sub ( ndhref )
#
# ndhref is a reference to the hash of an node_def element returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# To make an node_def hash consistent, all elements that can appear more than
# once in sequence are placed inside lists. These elements are:
#
# iface, link, and property
#
##############################################################################
sub XB_XOL_nodedef_list_sub ($)
{
my ($ndhref) = @_;
my ($ifref, $lnref, $vnref, $vnhref, $vnlref, $iflref, $ifhref, $lnlref, $lnhref);
my ($aref);
###################################
# Perform substitution for iface
# link, vnode and property elements
###################################
$ifref = $ndhref->{'iface'};
if (ref ($ifref) eq 'HASH')
{
$ndhref->{'iface'} = [ $ifref ]; # embedded in anonymous list
};
$iflref = $ndhref->{'iface'};
foreach $ifhref (@$iflref) # substitute in each iface element
{ XB_XOL_iface_list_sub ($ifhref); };
if (defined ($lnref = $ndhref->{'link'})) # link is optional
{
if (ref ($lnref) eq 'HASH')
{
$ndhref->{'link'} = [ $lnref ]; # embedded in anonymous list
};
$lnlref = $ndhref->{'link'};
foreach $lnhref (@$lnlref)
{ XB_XOL_link_list_sub ($lnhref); }; # substitute in each link element
};
if (defined ($vnref = $ndhref->{'vnode'})) # vnode is optional
{
if (ref ($vnref) eq 'HASH')
{
$ndhref->{'vnode'} = [ $vnref ]; # embedded in anonymous list
};
$vnlref = $ndhref->{'vnode'};
foreach $vnhref (@$vnlref)
{ XB_XOL_vnode_list_sub ($vnhref); }; # substitute in each vnode element
};
if (defined ($aref = $ndhref->{'application'})) # application is optional
{
if (ref ($aref) eq 'HASH')
{
$ndhref->{'application'} = [ $aref ]; # embedded in anonymous list
};
# dont bother if the application hash is already
# an array.
};
XB_XOL_property_list_sub ($ndhref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_iface_list_sub ( ifhref )
#
# ndhref is a reference to the hash of an iface element returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# To make an iface hash consistent, all elements that can appear more than
# once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_iface_list_sub ($)
{
my ($ifhref) = @_;
XB_XOL_property_list_sub ($ifhref); # substitute for any property element
################################
# If a renames element exists
# it may have a property element
################################
if (defined ($ifhref->{'renames'}))
{ XB_XOL_renames_list_sub ($ifhref->{'renames'}); };
};
##############################################################################
#
# sub XB_XOL_renames_list_sub ( rnhref )
#
# rnhref is a reference to the hash of a renames element returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# To make a renames hash consistent, all elements that can appear more than
# once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_renames_list_sub ($)
{
my ($rnhref) = @_;
XB_XOL_property_list_sub ($rnhref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_link_list_sub ( lnhref )
#
# lnhref is a reference to the hash of a link element returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# To make a link hash consistent, all elements that can appear more than
# once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_link_list_sub ($)
{
my ($lnhref) = @_;
XB_XOL_property_list_sub ($lnhref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_vnode_list_sub ( vnhref )
#
# vnhref is a reference to the hash of a vnode element returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# To make an vnode hash consistent, all elements that can appear more than
# once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_vnode_list_sub ($)
{
my ($vnhref) = @_;
XB_XOL_property_list_sub ($vnhref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_node_list_sub ( ndhref )
#
# ndhref is a reference to the hash of a node element returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# To make a node hash consistent, all elements that can appear more than
# once in sequence are placed inside lists. These elements are:
#
# property, tunnel
#
##############################################################################
sub XB_XOL_node_list_sub ($)
{
my ($ndhref) = @_;
my ($tnref, $tnhref, $tnlref);
XB_XOL_property_list_sub ($ndhref); # substitute for any property element
if (defined ($tnref = $ndhref->{'tunnel'}))
{
if (ref ($tnref) eq 'HASH')
{
$ndhref->{'tunnel'} = [ $tnref ]; # embedded in anonymous list
};
$tnlref = $ndhref->{'tunnel'};
foreach $tnhref (@$tnlref)
{
XB_XOL_tunnel_list_sub ($tnhref); # substitute into tunnel elements
};
};
};
##############################################################################
#
# sub XB_XOL_tunnel_list_sub ( tnhref )
#
# tnhref is a reference to the hash of a tunnel element returned by XML::Simple.
# The XML::Simple parse encloses mutiples of an element that appear in series
# in a list of hashes, whereas if a single element occurs in isolation, it is
# represented as a single hash.
#
# To make a tunnel hash consistent, all elements that can appear more than
# once in sequence are placed inside lists. These elements are:
#
# property
#
##############################################################################
sub XB_XOL_tunnel_list_sub ($)
{
my ($tnhref) = @_;
XB_XOL_property_list_sub ($tnhref); # substitute for any property element
};
##############################################################################
#
# sub XB_XOL_synonym_sub ( xolref, eqlref )
#
# Recursively descends through an XML::Simple hash structure for an xol_program
# element that is referenced by xolref. eqlref references a list of define_prop
# elements. Property elements in the xolref hash are examined for property
# elements that have a key field, but no value field. In such a case the
# key is assumed to be a synonym for some define_prop element definition.
#
# The matching define_prop property element is substituted in place for the synonym.
# If no match is found, an error occurs.
#
# Returns an empty string "" if the substitution pass succeeds.
# Otherwise, an error string is returned.
#
# NOTE: This routine MUST be called AFTER the routine XB_XOL_xbone_list_sub ()
# has operated on the xolref hash.
##############################################################################
sub XB_XOL_synonym_sub ($$)
{
no warnings; # recursive, so prototype causes warnings
my ($xolref, $eqlref) = @_;
my ($type, $retval);
$type = ref ($xolref);
if ($type eq 'HASH')
{
my ($name);
foreach $name (keys (%$xolref))
{
if ($name eq 'define_prop') # don't substitute into the definitions
{ next; }
elsif ($name eq 'property')
{
$retval = XB_XOL_properties_perform_substitution
($xolref->{$name}, $eqlref);
if ($retval) { return $retval; };
}
else
{
$retval = XB_XOL_synonym_sub ($xolref->{$name}, $eqlref);
if ($retval) { return $retval; };
};
};
}
elsif ($type eq 'ARRAY')
{
my ($lelmt);
foreach $lelmt (@$xolref)
{
$retval = XB_XOL_synonym_sub ($lelmt, $eqlref);
if ($retval) { return $retval; };
};
};
return ''; # Successful return is empty string, i.e. FALSE
};
##############################################################################
#
# sub XB_XOL_properties_perform_substitution ( href, eqlref )
#
# Examines hash of tag/value key pairs passed in href that are associated
# with a property element hash returned by XML::Simple. If a tag/value pair
# is missing its value key, the key is assumed to be a synonym. This synonym
# is presumed to be defined in some define_prop element definition in the list
# referenced by eqlref.
#
# Matching define_prop tag/value key pairs are substituted in place for
# each synonym encountered. If no match is found, an error occurs.
#
# Returns an empty string "" if the substitution pass succeeds.
# Otherwise, an error string is returned.
##############################################################################
sub XB_XOL_properties_perform_substitution ($$)
{
my ($href, $eqlref) = @_;
my ($key);
foreach $key (keys (%$href))
{
if (!defined ($href->{$key})) # no 'value' implies synonym substitution
{
my ($eqpref);
$eqpref = XB_XOL_define_prop_find ($eqlref, $key);
if (!defined ($eqpref))
{ return ("property $key has no matching define_prop synonym"); };
########################
# Apply the substitution
########################
$href->{$key} = $eqpref->{value};
};
};
};
##############################################################################
#
# sub XB_XOL_define_prop_find ( eqlref, synonym )
#
# Searches the define_prop element referenced by eqlref for a matching synonym.
#
# Returns a reference to the matching property list hash if a match is found.
# Otherwise, undef is returned.
##############################################################################
sub XB_XOL_define_prop_find ($$)
{
my ($eqlref, $synonym) = @_;
my ($synhref, $result);
#####################
# eqlref references
# a list of proplists
#####################
$result = undef;
foreach $synhref (@$eqlref)
{
if ((defined ($synhref->{'synonym'})) && ($synonym eq $synhref->{'synonym'}))
{
$result = $synhref->{'property'};
last;
};
};
return ($result);
}
##############################################################################
#
# sub XB_XML_choose_parse_error ( errorstrings )
#
# errorstrings contains the errors returned by a call to LibXML::parse_string()
# The last line containing an "error:" string are returned.
##############################################################################
sub XB_XML_choose_parse_error ($)
{
my ($errorstrings) = @_;
my (@lines, $line, $string, $ix);
@lines = split /\n/, $errorstrings;
$string = 'No error: found in LibXML::parse_string() response.';
$ix = 0;
while (defined ($lines[$ix]))
{
$_ = $lines[$ix];
if (/error:/is)
{ $string = "$lines[$ix]\n"; };
$ix++;
};
return ($string);
}
#my $msg = '';
#
#my $file = 'test1.xml';
##my $file = 'example.ring.xol';
#
#open(FILE, $file) || die ("\nCannot open the file: $file.\n");
#while (<FILE>) { $msg .= $_; };
#close(FILE);
#
#$_ = XB_XML_parse (\$msg);
#
#if (!$_)
# { print "\n\nSUCCESSFUL PARSE\n\n"; }
#else
# {
# print "\n\nFAILURE:\n$_\n$_\n\n";
# $_ = XB_XML_choose_parse_error ($_);
# print "CHOSEN ERROR STRING: $_\n\n";
# exit (1);
# };
#
#my $href = XB_XML_hash (\$msg);
#$_ = Dumper ($href);
#print "\n\nHASH:\n\n$_\n\n";
#
#
#my ($cmdhref, $covlhref, $xolhref);
#
#$cmdhref = $href->{'command'};
#$covlhref = $cmdhref->{'create_overlay'};
#$xolhref = $covlhref->{'xol_program'};
#
##XB_XOL_createovl_list_sub ($covlhref);
#
#XB_XOL_xbone_list_sub ($href);
#
#$_ = Dumper ($href);
#print "\n\nXOL PROGRAM LIST SUBSTITUTED:\n\n$_\n\n";
#
#XB_XOL_synonym_sub ($href, $xolhref->{'define_prop'});
#
#$_ = Dumper ($href);
#print "\n\nXOL PROGRAM SYNONYMS SUBSTITUTED:\n\n$_\n\n";
1; # Insure TRUE return if module is interpreted.
syntax highlighted by Code2HTML, v. 0.9.1