6811333 Remove prom_printf() message in emlxs driver
[opensolaris.git] / usr / src / lib / libbsm / xmlHandlers.pm
blobfbac98143845a76087c849df338103839df03de8
2 # CDDL HEADER START
4 # The contents of this file are subject to the terms of the
5 # Common Development and Distribution License (the "License").
6 # You may not use this file except in compliance with the License.
8 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
9 # or http://www.opensolaris.org/os/licensing.
10 # See the License for the specific language governing permissions
11 # and limitations under the License.
13 # When distributing Covered Code, include this CDDL HEADER in each
14 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
15 # If applicable, add the following below this CDDL HEADER, with the
16 # fields enclosed by brackets "[]" replaced with your own identifying
17 # information: Portions Copyright [yyyy] [name of copyright owner]
19 # CDDL HEADER END
22 # Copyright 2007 Sun Microsystems, Inc. All rights reserved.
23 # Use is subject to license terms.
25 # ident "%Z%%M% %I% %E% SMI"
28 # <t> xmlHandlers -- package for generating a tree from an XML doc
30 use XML::Parser;
32 package xmlHandlers;
34 $level = -1;
36 %endCallback = ();
37 %startCallback = ();
39 $currentObj = 0;
40 @objStack = ();
44 # <s> methods
46 # pkg reference, object name (tag), optional fileName.
49 sub new {
50 my $pkg = shift;
51 my $parent = shift; # ref to parent object
52 my $class = shift; # for debug use
54 my @kids = (); # list of child objects
56 push (@objStack, $parent);
57 $currentObj = bless {'class' => $class,
58 'kids' => \@kids,
59 # 'parent' => $parent,
60 'attributes' => 0,
61 'content' => ''}, $pkg;
63 if (@_) { # if fileName passed, go!
64 die "parent for document creation must be null"
65 if ($parent);
66 executeXML (shift);
68 return $currentObj;
71 # we'll call you when your object is started
72 # class method
74 sub registerStartCallback {
75 my $objName = shift; # call me when you get <objName>
76 my $callback = shift; # \&foo($objRef, $source);
78 if ($startCallback{$objName}) {
79 print STDERR "duplicate callback for $objName\n";
80 return;
82 $startCallback{$objName} = $callback;
86 # we'll call you when your object is completed
87 # class method
89 sub registerEndCallback {
90 my $objName = shift; # call me when you get </objName>
91 my $callback = shift; # \&foo($objRef);
93 if ($endCallback{$objName}) {
94 print STDERR "duplicate callback for $objName\n";
95 return;
97 $endCallback{$objName} = $callback;
100 sub start {
102 sub end {
105 sub char {
106 my ($obj, $class, $string) = @_;
111 sub add {
112 my $parent = shift;
113 my $kid = shift;
115 push (@{$parent->{'kids'}}, $kid);
116 # $kid->{'parent'} = $parent;
119 # <s> internal functions
120 sub executeXML {
121 my $file = shift;
123 # ErrorContext - 0 don't report errors
124 # - other = number of lines to display
125 # ParseparamEnt - 1 allow parsing of dtd
126 my $parser = XML::Parser->new(ErrorContext => 1,
127 ParseParamEnt => 1);
129 $parser->setHandlers (Char => \&charHandler,
130 Start => \&startHandler,
131 Default => \&defaultHandler,
132 End => \&endHandler,
133 Proc => \&procHandler,
134 Comment => \&commentHandler,
135 ExternEnt => \&externalHandler);
137 $parser->parsefile ($file);
140 sub charHandler {
141 my ($xmlObj, $string) = @_;
143 chomp $string;
144 $string =~ s/^\s+//;
145 $string =~ s/\s+$//;
146 unless ($string =~ /^\s*$/) {
147 # print "charHandler: $currentObj->{'class'} $string\n" if $main::debug;
148 $currentObj->{'content'} .= ' ' if ($currentObj->{'content'});
149 $currentObj->{'content'} .= $string;
153 # create new object and attach to tree
155 sub startHandler {
156 my $xmlObj = shift;
157 my $tag = shift;
159 my $obj;
160 my $parent = $currentObj;
162 $obj = new xmlHandlers($currentObj, $tag);
164 $parent->add ($obj);
166 $obj->processAttributes ($tag, @_);
168 my $functionRef;
169 if ($functionRef = $startCallback{$tag}) {
170 &$functionRef($obj, 'start');
172 elsif ($main::debug) {
173 # print "no start callback for $tag\n";
177 sub endHandler {
178 my $xmlObj = shift;
179 my $element = shift;
181 # print "end tag $element\n" if $main::debug;
183 my $functionRef;
184 if ($functionRef = $endCallback{$element}) {
185 &$functionRef($currentObj, 'end');
187 elsif ($main::debug) {
188 # print "no end callback for $element\n";
190 # $currentObj = $currentObj->{'parent'};
191 $currentObj = pop (@objStack);
194 sub defaultHandler {
195 my ($obj, $string) = @_;
197 unless (!$main::debug || ($string =~ /^\s*$/)) {
198 if ($string =~ /<\?xml/) {
199 $string =~ s/<\?\S+\s+(.*)/$1/;
200 my (%parameters) =
201 parseProcInstruction ($string);
202 print STDERR "Got call to default, guessed what to do: $string\n";
204 else {
205 print STDERR "Got call to default, didn't know what to do: $string\n";
210 sub externalHandler {
211 my ($obj, $base, $sysid, $pubid) = @_;
213 $base = '' if !$base;
214 $pubid = '' if !$pubid;
215 print "external: base $base\nexternal: sysid $sysid\nexternal: pubid $pubid\n";
218 sub commentHandler {
219 my ($obj, $element) = @_;
221 return unless $main::debug;
223 unless ($element =~ /^\s*$/) {
224 print "comment: $element\n";
228 sub procHandler {
229 my $xmlObj = shift;
230 my $target = shift;
231 my $data = shift;
233 my (%parameters) =
234 parseProcInstruction ($data);
236 $currentObj->processAttributes ($target, $data, @_);
238 #<s> misc subs
240 sub parseProcInstruction {
241 my ($args) = @_;
243 my (@outputArray) = ();
245 while ($args =~ s/([^ =]+)=\"([^"]+)\"(.*)/$3/) { # "
246 push (@outputArray, $1);
247 push (@outputArray, $2);
249 return (@outputArray);
252 sub processAttributes {
253 my $pkg = shift;
254 my ($element, %content) = @_;
256 # print "processAttributes: element = $element\n" if $main::debug;
258 my $hashCount = 0;
259 foreach $attributeName (keys %content) {
260 if ($attributeName =~ /^\s*$/) {
261 delete $content{$attributeName}; # remove null entries
262 next;
264 $hashCount++;
265 # print "attribute: $attributeName = $content{$attributeName}\n"
266 # if $main::debug;
268 if ($hashCount && $pkg->{'attributes'}) {
269 print STDERR "need to write attribute merge logic\n";
271 else {
272 $pkg->{'attributes'} = \%content;
276 sub getKid {
277 my $pkg = shift;
278 my $whichKid = shift;
280 my @kids = $pkg->getKids();
281 my $kid;
282 foreach $kid (@kids) {
283 my $class = $kid->getClass();
284 return $kid if $class eq $whichKid;
286 return undef;
289 sub getKids {
290 my $pkg = shift;
292 return @{$pkg->{'kids'}};
295 sub getAttributes {
296 my $pkg = shift;
298 my $ref = $pkg->{'attributes'};
300 return %$ref;
303 sub getAttr {
304 my $pkg = shift;
305 my $attr = shift;
307 my $ref = $pkg->{'attributes'};
309 return $$ref{$attr};
312 sub getClass {
313 my $pkg = shift;
315 return $pkg->{'class'};
318 sub getContent {
319 my $pkg = shift;
321 my $content = $pkg->{'content'};
322 return $content ? $content : undef;