1*c0c79a3fStz# 2*c0c79a3fStz# CDDL HEADER START 3*c0c79a3fStz# 4*c0c79a3fStz# The contents of this file are subject to the terms of the 5*c0c79a3fStz# Common Development and Distribution License (the "License"). 6*c0c79a3fStz# You may not use this file except in compliance with the License. 7*c0c79a3fStz# 8*c0c79a3fStz# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE 9*c0c79a3fStz# or http://www.opensolaris.org/os/licensing. 10*c0c79a3fStz# See the License for the specific language governing permissions 11*c0c79a3fStz# and limitations under the License. 12*c0c79a3fStz# 13*c0c79a3fStz# When distributing Covered Code, include this CDDL HEADER in each 14*c0c79a3fStz# file and include the License file at usr/src/OPENSOLARIS.LICENSE. 15*c0c79a3fStz# If applicable, add the following below this CDDL HEADER, with the 16*c0c79a3fStz# fields enclosed by brackets "[]" replaced with your own identifying 17*c0c79a3fStz# information: Portions Copyright [yyyy] [name of copyright owner] 18*c0c79a3fStz# 19*c0c79a3fStz# CDDL HEADER END 20*c0c79a3fStz# 21*c0c79a3fStz# 22*c0c79a3fStz# Copyright 2007 Sun Microsystems, Inc. All rights reserved. 23*c0c79a3fStz# Use is subject to license terms. 24*c0c79a3fStz# 25*c0c79a3fStz# ident "%Z%%M% %I% %E% SMI" 26*c0c79a3fStz# 27*c0c79a3fStz 28*c0c79a3fStz# <t> xmlHandlers -- package for generating a tree from an XML doc 29*c0c79a3fStz 30*c0c79a3fStzuse XML::Parser; 31*c0c79a3fStz 32*c0c79a3fStzpackage xmlHandlers; 33*c0c79a3fStz 34*c0c79a3fStz$level = -1; 35*c0c79a3fStz 36*c0c79a3fStz%endCallback = (); 37*c0c79a3fStz%startCallback = (); 38*c0c79a3fStz 39*c0c79a3fStz$currentObj = 0; 40*c0c79a3fStz@objStack = (); 41*c0c79a3fStz 42*c0c79a3fStz1; 43*c0c79a3fStz 44*c0c79a3fStz# <s> methods 45*c0c79a3fStz 46*c0c79a3fStz# pkg reference, object name (tag), optional fileName. 47*c0c79a3fStz 48*c0c79a3fStz 49*c0c79a3fStzsub new { 50*c0c79a3fStz my $pkg = shift; 51*c0c79a3fStz my $parent = shift; # ref to parent object 52*c0c79a3fStz my $class = shift; # for debug use 53*c0c79a3fStz 54*c0c79a3fStz my @kids = (); # list of child objects 55*c0c79a3fStz 56*c0c79a3fStz push (@objStack, $parent); 57*c0c79a3fStz $currentObj = bless {'class' => $class, 58*c0c79a3fStz 'kids' => \@kids, 59*c0c79a3fStz# 'parent' => $parent, 60*c0c79a3fStz 'attributes' => 0, 61*c0c79a3fStz 'content' => ''}, $pkg; 62*c0c79a3fStz 63*c0c79a3fStz if (@_) { # if fileName passed, go! 64*c0c79a3fStz die "parent for document creation must be null" 65*c0c79a3fStz if ($parent); 66*c0c79a3fStz executeXML (shift); 67*c0c79a3fStz } 68*c0c79a3fStz return $currentObj; 69*c0c79a3fStz} 70*c0c79a3fStz 71*c0c79a3fStz# we'll call you when your object is started 72*c0c79a3fStz# class method 73*c0c79a3fStz 74*c0c79a3fStzsub registerStartCallback { 75*c0c79a3fStz my $objName = shift; # call me when you get <objName> 76*c0c79a3fStz my $callback = shift; # \&foo($objRef, $source); 77*c0c79a3fStz 78*c0c79a3fStz if ($startCallback{$objName}) { 79*c0c79a3fStz print STDERR "duplicate callback for $objName\n"; 80*c0c79a3fStz return; 81*c0c79a3fStz } 82*c0c79a3fStz $startCallback{$objName} = $callback; 83*c0c79a3fStz} 84*c0c79a3fStz 85*c0c79a3fStz 86*c0c79a3fStz# we'll call you when your object is completed 87*c0c79a3fStz# class method 88*c0c79a3fStz 89*c0c79a3fStzsub registerEndCallback { 90*c0c79a3fStz my $objName = shift; # call me when you get </objName> 91*c0c79a3fStz my $callback = shift; # \&foo($objRef); 92*c0c79a3fStz 93*c0c79a3fStz if ($endCallback{$objName}) { 94*c0c79a3fStz print STDERR "duplicate callback for $objName\n"; 95*c0c79a3fStz return; 96*c0c79a3fStz } 97*c0c79a3fStz $endCallback{$objName} = $callback; 98*c0c79a3fStz} 99*c0c79a3fStz 100*c0c79a3fStzsub start { 101*c0c79a3fStz} 102*c0c79a3fStzsub end { 103*c0c79a3fStz} 104*c0c79a3fStz 105*c0c79a3fStzsub char { 106*c0c79a3fStz my ($obj, $class, $string) = @_; 107*c0c79a3fStz 108*c0c79a3fStz 109*c0c79a3fStz} 110*c0c79a3fStz 111*c0c79a3fStzsub add { 112*c0c79a3fStz my $parent = shift; 113*c0c79a3fStz my $kid = shift; 114*c0c79a3fStz 115*c0c79a3fStz push (@{$parent->{'kids'}}, $kid); 116*c0c79a3fStz# $kid->{'parent'} = $parent; 117*c0c79a3fStz} 118*c0c79a3fStz 119*c0c79a3fStz# <s> internal functions 120*c0c79a3fStzsub executeXML { 121*c0c79a3fStz my $file = shift; 122*c0c79a3fStz 123*c0c79a3fStz # ErrorContext - 0 don't report errors 124*c0c79a3fStz # - other = number of lines to display 125*c0c79a3fStz # ParseparamEnt - 1 allow parsing of dtd 126*c0c79a3fStz my $parser = XML::Parser->new(ErrorContext => 1, 127*c0c79a3fStz ParseParamEnt => 1); 128*c0c79a3fStz 129*c0c79a3fStz $parser->setHandlers (Char => \&charHandler, 130*c0c79a3fStz Start => \&startHandler, 131*c0c79a3fStz Default => \&defaultHandler, 132*c0c79a3fStz End => \&endHandler, 133*c0c79a3fStz Proc => \&procHandler, 134*c0c79a3fStz Comment => \&commentHandler, 135*c0c79a3fStz ExternEnt => \&externalHandler); 136*c0c79a3fStz 137*c0c79a3fStz $parser->parsefile ($file); 138*c0c79a3fStz} 139*c0c79a3fStz 140*c0c79a3fStzsub charHandler { 141*c0c79a3fStz my ($xmlObj, $string) = @_; 142*c0c79a3fStz 143*c0c79a3fStz chomp $string; 144*c0c79a3fStz $string =~ s/^\s+//; 145*c0c79a3fStz $string =~ s/\s+$//; 146*c0c79a3fStz unless ($string =~ /^\s*$/) { 147*c0c79a3fStz# print "charHandler: $currentObj->{'class'} $string\n" if $main::debug; 148*c0c79a3fStz $currentObj->{'content'} .= ' ' if ($currentObj->{'content'}); 149*c0c79a3fStz $currentObj->{'content'} .= $string; 150*c0c79a3fStz } 151*c0c79a3fStz} 152*c0c79a3fStz 153*c0c79a3fStz# create new object and attach to tree 154*c0c79a3fStz 155*c0c79a3fStzsub startHandler { 156*c0c79a3fStz my $xmlObj = shift; 157*c0c79a3fStz my $tag = shift; 158*c0c79a3fStz 159*c0c79a3fStz my $obj; 160*c0c79a3fStz my $parent = $currentObj; 161*c0c79a3fStz 162*c0c79a3fStz $obj = new xmlHandlers($currentObj, $tag); 163*c0c79a3fStz 164*c0c79a3fStz $parent->add ($obj); 165*c0c79a3fStz 166*c0c79a3fStz $obj->processAttributes ($tag, @_); 167*c0c79a3fStz 168*c0c79a3fStz my $functionRef; 169*c0c79a3fStz if ($functionRef = $startCallback{$tag}) { 170*c0c79a3fStz &$functionRef($obj, 'start'); 171*c0c79a3fStz } 172*c0c79a3fStz elsif ($main::debug) { 173*c0c79a3fStz# print "no start callback for $tag\n"; 174*c0c79a3fStz } 175*c0c79a3fStz} 176*c0c79a3fStz 177*c0c79a3fStzsub endHandler { 178*c0c79a3fStz my $xmlObj = shift; 179*c0c79a3fStz my $element = shift; 180*c0c79a3fStz 181*c0c79a3fStz# print "end tag $element\n" if $main::debug; 182*c0c79a3fStz 183*c0c79a3fStz my $functionRef; 184*c0c79a3fStz if ($functionRef = $endCallback{$element}) { 185*c0c79a3fStz &$functionRef($currentObj, 'end'); 186*c0c79a3fStz } 187*c0c79a3fStz elsif ($main::debug) { 188*c0c79a3fStz# print "no end callback for $element\n"; 189*c0c79a3fStz } 190*c0c79a3fStz# $currentObj = $currentObj->{'parent'}; 191*c0c79a3fStz $currentObj = pop (@objStack); 192*c0c79a3fStz} 193*c0c79a3fStz 194*c0c79a3fStzsub defaultHandler { 195*c0c79a3fStz my ($obj, $string) = @_; 196*c0c79a3fStz 197*c0c79a3fStz unless (!$main::debug || ($string =~ /^\s*$/)) { 198*c0c79a3fStz if ($string =~ /<\?xml/) { 199*c0c79a3fStz $string =~ s/<\?\S+\s+(.*)/$1/; 200*c0c79a3fStz my (%parameters) = 201*c0c79a3fStz parseProcInstruction ($string); 202*c0c79a3fStz print STDERR "Got call to default, guessed what to do: $string\n"; 203*c0c79a3fStz } 204*c0c79a3fStz else { 205*c0c79a3fStz print STDERR "Got call to default, didn't know what to do: $string\n"; 206*c0c79a3fStz } 207*c0c79a3fStz } 208*c0c79a3fStz} 209*c0c79a3fStz 210*c0c79a3fStzsub externalHandler { 211*c0c79a3fStz my ($obj, $base, $sysid, $pubid) = @_; 212*c0c79a3fStz 213*c0c79a3fStz $base = '' if !$base; 214*c0c79a3fStz $pubid = '' if !$pubid; 215*c0c79a3fStz print "external: base $base\nexternal: sysid $sysid\nexternal: pubid $pubid\n"; 216*c0c79a3fStz} 217*c0c79a3fStz 218*c0c79a3fStzsub commentHandler { 219*c0c79a3fStz my ($obj, $element) = @_; 220*c0c79a3fStz 221*c0c79a3fStz return unless $main::debug; 222*c0c79a3fStz 223*c0c79a3fStz unless ($element =~ /^\s*$/) { 224*c0c79a3fStz print "comment: $element\n"; 225*c0c79a3fStz } 226*c0c79a3fStz} 227*c0c79a3fStz 228*c0c79a3fStzsub procHandler { 229*c0c79a3fStz my $xmlObj = shift; 230*c0c79a3fStz my $target = shift; 231*c0c79a3fStz my $data = shift; 232*c0c79a3fStz 233*c0c79a3fStz my (%parameters) = 234*c0c79a3fStz parseProcInstruction ($data); 235*c0c79a3fStz 236*c0c79a3fStz $currentObj->processAttributes ($target, $data, @_); 237*c0c79a3fStz} 238*c0c79a3fStz#<s> misc subs 239*c0c79a3fStz 240*c0c79a3fStzsub parseProcInstruction { 241*c0c79a3fStz my ($args) = @_; 242*c0c79a3fStz 243*c0c79a3fStz my (@outputArray) = (); 244*c0c79a3fStz 245*c0c79a3fStz while ($args =~ s/([^ =]+)=\"([^"]+)\"(.*)/$3/) { # " 246*c0c79a3fStz push (@outputArray, $1); 247*c0c79a3fStz push (@outputArray, $2); 248*c0c79a3fStz } 249*c0c79a3fStz return (@outputArray); 250*c0c79a3fStz} 251*c0c79a3fStz 252*c0c79a3fStzsub processAttributes { 253*c0c79a3fStz my $pkg = shift; 254*c0c79a3fStz my ($element, %content) = @_; 255*c0c79a3fStz 256*c0c79a3fStz# print "processAttributes: element = $element\n" if $main::debug; 257*c0c79a3fStz 258*c0c79a3fStz my $hashCount = 0; 259*c0c79a3fStz foreach $attributeName (keys %content) { 260*c0c79a3fStz if ($attributeName =~ /^\s*$/) { 261*c0c79a3fStz delete $content{$attributeName}; # remove null entries 262*c0c79a3fStz next; 263*c0c79a3fStz } 264*c0c79a3fStz $hashCount++; 265*c0c79a3fStz# print "attribute: $attributeName = $content{$attributeName}\n" 266*c0c79a3fStz# if $main::debug; 267*c0c79a3fStz } 268*c0c79a3fStz if ($hashCount && $pkg->{'attributes'}) { 269*c0c79a3fStz print STDERR "need to write attribute merge logic\n"; 270*c0c79a3fStz } 271*c0c79a3fStz else { 272*c0c79a3fStz $pkg->{'attributes'} = \%content; 273*c0c79a3fStz } 274*c0c79a3fStz} 275*c0c79a3fStz 276*c0c79a3fStzsub getKid { 277*c0c79a3fStz my $pkg = shift; 278*c0c79a3fStz my $whichKid = shift; 279*c0c79a3fStz 280*c0c79a3fStz my @kids = $pkg->getKids(); 281*c0c79a3fStz my $kid; 282*c0c79a3fStz foreach $kid (@kids) { 283*c0c79a3fStz my $class = $kid->getClass(); 284*c0c79a3fStz return $kid if $class eq $whichKid; 285*c0c79a3fStz } 286*c0c79a3fStz return undef; 287*c0c79a3fStz} 288*c0c79a3fStz 289*c0c79a3fStzsub getKids { 290*c0c79a3fStz my $pkg = shift; 291*c0c79a3fStz 292*c0c79a3fStz return @{$pkg->{'kids'}}; 293*c0c79a3fStz} 294*c0c79a3fStz 295*c0c79a3fStzsub getAttributes { 296*c0c79a3fStz my $pkg = shift; 297*c0c79a3fStz 298*c0c79a3fStz my $ref = $pkg->{'attributes'}; 299*c0c79a3fStz 300*c0c79a3fStz return %$ref; 301*c0c79a3fStz} 302*c0c79a3fStz 303*c0c79a3fStzsub getAttr { 304*c0c79a3fStz my $pkg = shift; 305*c0c79a3fStz my $attr = shift; 306*c0c79a3fStz 307*c0c79a3fStz my $ref = $pkg->{'attributes'}; 308*c0c79a3fStz 309*c0c79a3fStz return $$ref{$attr}; 310*c0c79a3fStz} 311*c0c79a3fStz 312*c0c79a3fStzsub getClass { 313*c0c79a3fStz my $pkg = shift; 314*c0c79a3fStz 315*c0c79a3fStz return $pkg->{'class'}; 316*c0c79a3fStz} 317*c0c79a3fStz 318*c0c79a3fStzsub getContent { 319*c0c79a3fStz my $pkg = shift; 320*c0c79a3fStz 321*c0c79a3fStz my $content = $pkg->{'content'}; 322*c0c79a3fStz return $content ? $content : undef; 323*c0c79a3fStz} 324