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