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