1 |
cvsjoko |
1.1 |
############################################################################### |
2 |
|
|
# |
3 |
|
|
# This file copyright (c) 2001 by Randy J. Ray, all rights reserved |
4 |
|
|
# |
5 |
|
|
# Copying and distribution are permitted under the terms of the Artistic |
6 |
|
|
# License as distributed with Perl versions 5.005 and later. See |
7 |
|
|
# http://language.perl.com/misc/Artistic.html |
8 |
|
|
# |
9 |
|
|
############################################################################### |
10 |
|
|
# |
11 |
|
|
# $Id: Parser.pm,v 1.4 2002/05/22 09:44:49 rjray Exp $ |
12 |
|
|
# |
13 |
|
|
# Description: This is the RPC::XML::Parser class, a container for the |
14 |
|
|
# XML::Parser class. It was moved here from RPC::XML in |
15 |
|
|
# order to reduce the weight of that module. |
16 |
|
|
# |
17 |
|
|
# Functions: new |
18 |
|
|
# parse |
19 |
|
|
# message_init |
20 |
|
|
# tag_start |
21 |
|
|
# error |
22 |
|
|
# stack_error |
23 |
|
|
# tag_end |
24 |
|
|
# char_data |
25 |
|
|
# |
26 |
|
|
# Libraries: RPC::XML |
27 |
|
|
# XML::Parser |
28 |
|
|
# |
29 |
|
|
# Global Consts: Uses $RPC::XML::ERROR |
30 |
|
|
# |
31 |
|
|
# Environment: None. |
32 |
|
|
# |
33 |
|
|
############################################################################### |
34 |
|
|
|
35 |
|
|
package RPC::XML::Parser; |
36 |
|
|
|
37 |
|
|
use 5.005; |
38 |
|
|
use strict; |
39 |
|
|
use vars qw($VERSION @ISA); |
40 |
|
|
use subs qw(error stack_error new message_init message_end tag_start tag_end |
41 |
|
|
char_data parse); |
42 |
|
|
|
43 |
|
|
# These constants are only used by the internal stack machine |
44 |
|
|
use constant PARSE_ERROR => 0; |
45 |
|
|
use constant METHOD => 1; |
46 |
|
|
use constant METHODSET => 2; |
47 |
|
|
use constant RESPONSE => 3; |
48 |
|
|
use constant RESPONSESET => 4; |
49 |
|
|
use constant STRUCT => 5; |
50 |
|
|
use constant ARRAY => 6; |
51 |
|
|
use constant DATATYPE => 7; |
52 |
|
|
use constant ATTR_SET => 8; |
53 |
|
|
use constant METHODNAME => 9; |
54 |
|
|
use constant VALUEMARKER => 10; |
55 |
|
|
use constant PARAMSTART => 11; |
56 |
|
|
use constant PARAM => 12; |
57 |
|
|
use constant STRUCTMEM => 13; |
58 |
|
|
use constant STRUCTNAME => 14; |
59 |
|
|
use constant DATAOBJECT => 15; |
60 |
|
|
use constant PARAMLIST => 16; |
61 |
|
|
use constant NAMEVAL => 17; |
62 |
|
|
use constant MEMBERENT => 18; |
63 |
|
|
use constant METHODENT => 19; |
64 |
|
|
use constant RESPONSEENT => 20; |
65 |
|
|
use constant FAULTENT => 21; |
66 |
|
|
use constant FAULTSTART => 22; |
67 |
|
|
|
68 |
|
|
# This is to identify valid types |
69 |
|
|
use constant VALIDTYPES => { map { $_, 1 } qw(int i4 string double reference |
70 |
|
|
boolean dateTime.iso8601 |
71 |
|
|
base64) }; |
72 |
|
|
# This maps XML tags to stack-machine tokens |
73 |
|
|
use constant TAG2TOKEN => { methodCall => METHOD, |
74 |
|
|
methodResponse => RESPONSE, |
75 |
|
|
methodName => METHODNAME, |
76 |
|
|
params => PARAMSTART, |
77 |
|
|
param => PARAM, |
78 |
|
|
value => VALUEMARKER, |
79 |
|
|
fault => FAULTSTART, |
80 |
|
|
array => ARRAY, |
81 |
|
|
struct => STRUCT, |
82 |
|
|
member => STRUCTMEM, |
83 |
|
|
name => STRUCTNAME }; |
84 |
|
|
|
85 |
|
|
use XML::Parser; |
86 |
|
|
|
87 |
|
|
require RPC::XML; |
88 |
|
|
|
89 |
|
|
$VERSION = do { my @r=(q$Revision: 1.4 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r }; |
90 |
|
|
|
91 |
|
|
1; |
92 |
|
|
|
93 |
|
|
############################################################################### |
94 |
|
|
# |
95 |
|
|
# Sub Name: new |
96 |
|
|
# |
97 |
|
|
# Description: Constructor. Save any important attributes, leave the |
98 |
|
|
# heavy lifting for the parse() routine and XML::Parser. |
99 |
|
|
# |
100 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
101 |
|
|
# $class in scalar Class we're initializing |
102 |
|
|
# %attr in hash Any extras the caller wants |
103 |
|
|
# |
104 |
|
|
# Globals: $RPC::XML::ERROR |
105 |
|
|
# |
106 |
|
|
# Environment: None. |
107 |
|
|
# |
108 |
|
|
# Returns: Success: object ref |
109 |
|
|
# Failure: undef |
110 |
|
|
# |
111 |
|
|
############################################################################### |
112 |
|
|
sub new |
113 |
|
|
{ |
114 |
|
|
my $class = shift; |
115 |
|
|
my %attrs = @_; |
116 |
|
|
|
117 |
|
|
my $self = {}; |
118 |
|
|
if (keys %attrs) |
119 |
|
|
{ |
120 |
|
|
for (keys %attrs) { $self->{$_} = $attrs{$_} } |
121 |
|
|
} |
122 |
|
|
|
123 |
|
|
bless $self, $class; |
124 |
|
|
} |
125 |
|
|
|
126 |
|
|
############################################################################### |
127 |
|
|
# |
128 |
|
|
# Sub Name: parse |
129 |
|
|
# |
130 |
|
|
# Description: Parse the requested string or stream. This behaves mostly |
131 |
|
|
# like parse() in the XML::Parser namespace, but does some |
132 |
|
|
# extra, as well. |
133 |
|
|
# |
134 |
|
|
# Arguments: NAME IN/OUT TYPE DESCRIPTION |
135 |
|
|
# $self in ref Object of this class |
136 |
|
|
# $stream in scalar Either the string to parse or |
137 |
|
|
# an open filehandle of sorts |
138 |
|
|
# |
139 |
|
|
# Globals: None. |
140 |
|
|
# |
141 |
|
|
# Environment: None. |
142 |
|
|
# |
143 |
|
|
# Returns: Success: ref to request or response object |
144 |
|
|
# Failure: error string |
145 |
|
|
# |
146 |
|
|
############################################################################### |
147 |
|
|
sub parse |
148 |
|
|
{ |
149 |
|
|
my $self = shift; |
150 |
|
|
my $stream = shift; |
151 |
|
|
|
152 |
|
|
my $parser = XML::Parser->new(Namespaces => 0, ParseParamEnt => 0, |
153 |
|
|
Handlers => |
154 |
|
|
{ |
155 |
|
|
Init => sub { message_init $self, @_ }, |
156 |
|
|
Start => sub { tag_start $self, @_ }, |
157 |
|
|
End => sub { tag_end $self, @_ }, |
158 |
|
|
Char => sub { char_data $self, @_ }, |
159 |
|
|
}); |
160 |
|
|
|
161 |
|
|
eval { $parser->parse($stream) }; |
162 |
|
|
return $@ if $@; |
163 |
|
|
# Look at the top-most marker, it'll need to be one of the end cases |
164 |
|
|
my $marker = pop(@{$self->{stack}}); |
165 |
|
|
# There should be only on item on the stack after it |
166 |
|
|
my $retval = pop(@{$self->{stack}}); |
167 |
|
|
# If the top-most marker isn't the error marker, check the stack |
168 |
|
|
$retval = 'RPC::XML Error: Extra data on parse stack at document end' |
169 |
|
|
if ($marker != PARSE_ERROR and (@{$self->{stack}})); |
170 |
|
|
|
171 |
|
|
$retval; |
172 |
|
|
} |
173 |
|
|
|
174 |
|
|
# This is called when a new document is about to start parsing |
175 |
|
|
sub message_init |
176 |
|
|
{ |
177 |
|
|
my $robj = shift; |
178 |
|
|
my $self = shift; |
179 |
|
|
|
180 |
|
|
$robj->{stack} = []; |
181 |
|
|
$self; |
182 |
|
|
} |
183 |
|
|
|
184 |
|
|
# This gets called each time an opening tag is parsed |
185 |
|
|
sub tag_start |
186 |
|
|
{ |
187 |
|
|
my $robj = shift; |
188 |
|
|
my $self = shift; |
189 |
|
|
my $elem = shift; |
190 |
|
|
my %attr = @_; |
191 |
|
|
|
192 |
|
|
$robj->{cdata} = ''; |
193 |
|
|
return if ($elem eq 'data'); |
194 |
|
|
if (TAG2TOKEN->{$elem}) |
195 |
|
|
{ |
196 |
|
|
push(@{$robj->{stack}}, TAG2TOKEN->{$elem}); |
197 |
|
|
} |
198 |
|
|
elsif (VALIDTYPES->{$elem}) |
199 |
|
|
{ |
200 |
|
|
# All datatypes are represented on the stack by this generic token |
201 |
|
|
push(@{$robj->{stack}}, DATATYPE); |
202 |
|
|
} |
203 |
|
|
else |
204 |
|
|
{ |
205 |
|
|
push(@{$robj->{stack}}, |
206 |
|
|
"Unknown tag encountered: $elem", PARSE_ERROR); |
207 |
|
|
$self->finish; |
208 |
|
|
} |
209 |
|
|
} |
210 |
|
|
|
211 |
|
|
# Very simple error-text generator, just to eliminate heavy reduncancy in the |
212 |
|
|
# next sub: |
213 |
|
|
sub error |
214 |
|
|
{ |
215 |
|
|
my $robj = shift; |
216 |
|
|
my $self = shift; |
217 |
|
|
my $mesg = shift; |
218 |
|
|
my $elem = shift || ''; |
219 |
|
|
|
220 |
|
|
my $fmt = $elem ? |
221 |
|
|
'%s at document line %d, column %d (byte %d, closing tag %s)' : |
222 |
|
|
'%s at document line %d, column %d (byte %d)'; |
223 |
|
|
|
224 |
|
|
push(@{$robj->{stack}}, |
225 |
|
|
sprintf($fmt, $mesg, $self->current_line, $self->current_column, |
226 |
|
|
$self->current_byte, $elem), |
227 |
|
|
PARSE_ERROR); |
228 |
|
|
$self->finish; |
229 |
|
|
} |
230 |
|
|
|
231 |
|
|
# A shorter-cut for stack integrity errors |
232 |
|
|
sub stack_error |
233 |
|
|
{ |
234 |
|
|
my $robj = shift; |
235 |
|
|
my $self = shift; |
236 |
|
|
my $elem = shift; |
237 |
|
|
|
238 |
|
|
error($robj, $self, 'Stack corruption detected', $elem); |
239 |
|
|
} |
240 |
|
|
|
241 |
|
|
# This is a hairy subroutine-- what to do at the end-tag. The actions range |
242 |
|
|
# from simply new-ing a datatype all the way to building the final object. |
243 |
|
|
sub tag_end |
244 |
|
|
{ |
245 |
|
|
my $robj = shift; |
246 |
|
|
my $self = shift; |
247 |
|
|
my $elem = shift; |
248 |
|
|
|
249 |
|
|
my ($op, $attr, $obj, $class, $list, $name, $err); |
250 |
|
|
|
251 |
|
|
return if ($elem eq 'data'); |
252 |
|
|
# This should always be one of the stack machine ops defined above |
253 |
|
|
$op = pop(@{$robj->{stack}}); |
254 |
|
|
|
255 |
|
|
# Decide what to do from here |
256 |
|
|
if (VALIDTYPES->{$elem}) |
257 |
|
|
{ |
258 |
|
|
# This is the closing tag of one of the data-types. |
259 |
|
|
($class = lc $elem) =~ s/\./_/; |
260 |
|
|
# Some minimal data-integrity checking |
261 |
|
|
if ($class eq 'int' or $class eq 'i4') |
262 |
|
|
{ |
263 |
|
|
return error($robj, $self, 'Bad integer data read') |
264 |
|
|
unless ($robj->{cdata} =~ /^[-+]?\d+$/); |
265 |
|
|
} |
266 |
|
|
elsif ($class eq 'double') |
267 |
|
|
{ |
268 |
|
|
return error($robj, $self, 'Bad floating-point data read') |
269 |
|
|
unless ($robj->{cdata} =~ |
270 |
|
|
# Taken from perldata(1) |
271 |
|
|
/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); |
272 |
|
|
} |
273 |
|
|
|
274 |
|
|
$class = "RPC::XML::$class"; |
275 |
|
|
$obj = $class->new($robj->{cdata}); |
276 |
|
|
return error($robj, $self, 'Error instantiating data object: ' . |
277 |
|
|
$RPC::XML::ERROR) |
278 |
|
|
unless ($obj); |
279 |
|
|
push(@{$robj->{stack}}, $obj, DATAOBJECT); |
280 |
|
|
} |
281 |
|
|
elsif ($elem eq 'value') |
282 |
|
|
{ |
283 |
|
|
# For <value></value>, there should already be a dataobject, or else |
284 |
|
|
# the marker token in which case the CDATA is used as a string value. |
285 |
|
|
if ($op == DATAOBJECT) |
286 |
|
|
{ |
287 |
|
|
($op, $obj) = splice(@{$robj->{stack}}, -2); |
288 |
|
|
return stack_error($robj, $self, $elem) |
289 |
|
|
unless ($op == VALUEMARKER); |
290 |
|
|
} |
291 |
|
|
elsif ($op == VALUEMARKER) |
292 |
|
|
{ |
293 |
|
|
$obj = RPC::XML::string->new($robj->{cdata}); |
294 |
|
|
} |
295 |
|
|
else |
296 |
|
|
{ |
297 |
|
|
return error($robj, $self, |
298 |
|
|
'No datatype found within <value> container'); |
299 |
|
|
} |
300 |
|
|
|
301 |
|
|
push(@{$robj->{stack}}, $obj, DATAOBJECT); |
302 |
|
|
} |
303 |
|
|
elsif ($elem eq 'param') |
304 |
|
|
{ |
305 |
|
|
# Almost like above, since this is really a NOP anyway |
306 |
|
|
return error($robj, $self, 'No <value> found within <param> container') |
307 |
|
|
unless ($op == DATAOBJECT); |
308 |
|
|
($op, $obj) = splice(@{$robj->{stack}}, -2); |
309 |
|
|
return stack_error($robj, $self, $elem) unless ($op == PARAM); |
310 |
|
|
push(@{$robj->{stack}}, $obj, DATAOBJECT); |
311 |
|
|
} |
312 |
|
|
elsif ($elem eq 'params') |
313 |
|
|
{ |
314 |
|
|
# At this point, there should be zero or more DATAOBJECT tokens on the |
315 |
|
|
# stack, each with a data object right below it. |
316 |
|
|
$list = []; |
317 |
|
|
return stack_error($robj, $self, $elem) |
318 |
|
|
unless ($op == DATAOBJECT or $op == PARAMSTART); |
319 |
|
|
while ($op == DATAOBJECT) |
320 |
|
|
{ |
321 |
|
|
unshift(@$list, pop(@{$robj->{stack}})); |
322 |
|
|
$op = pop(@{$robj->{stack}}); |
323 |
|
|
} |
324 |
|
|
# Now that we see something ! DATAOBJECT, it needs to be PARAMSTART |
325 |
|
|
return stack_error($robj, $self, $elem) unless ($op == PARAMSTART); |
326 |
|
|
push(@{$robj->{stack}}, $list, PARAMLIST); |
327 |
|
|
} |
328 |
|
|
elsif ($elem eq 'fault') |
329 |
|
|
{ |
330 |
|
|
# If we're finishing up a fault definition, there needs to be a struct |
331 |
|
|
# on the stack. |
332 |
|
|
return stack_error($robj, $self, $elem) unless ($op == DATAOBJECT); |
333 |
|
|
($op, $obj) = splice(@{$robj->{stack}}, -2); |
334 |
|
|
return error($robj, $self, |
335 |
|
|
'Only a <struct> value may be within a <fault>') |
336 |
|
|
unless ($obj->isa('RPC::XML::struct')); |
337 |
|
|
|
338 |
|
|
$obj = RPC::XML::fault->new($obj); |
339 |
|
|
return error($robj, $self, 'Unable to instantiate fault object: ' . |
340 |
|
|
$RPC::XML::ERROR) |
341 |
|
|
unless $obj; |
342 |
|
|
push(@{$robj->{stack}}, $obj, FAULTENT); |
343 |
|
|
} |
344 |
|
|
elsif ($elem eq 'member') |
345 |
|
|
{ |
346 |
|
|
# We need to see a DATAOBJECT followed by a STRUCTNAME |
347 |
|
|
return stack_error($robj, $self, $elem) unless ($op == DATAOBJECT); |
348 |
|
|
($op, $obj) = splice(@{$robj->{stack}}, -2); |
349 |
|
|
return stack_error($robj, $self, $elem) unless ($op == STRUCTNAME); |
350 |
|
|
# Get the name off the stack to clear the way for the STRUCTMEM marker |
351 |
|
|
# under it |
352 |
|
|
($op, $name) = splice(@{$robj->{stack}}, -2); |
353 |
|
|
# Push the name back on, with the value and the new marker (STRUCTMEM) |
354 |
|
|
push(@{$robj->{stack}}, $name, $obj, STRUCTMEM); |
355 |
|
|
} |
356 |
|
|
elsif ($elem eq 'name') |
357 |
|
|
{ |
358 |
|
|
# Fairly simple: just push the current content of CDATA on w/ a marker |
359 |
|
|
push(@{$robj->{stack}}, $robj->{cdata}, STRUCTNAME); |
360 |
|
|
} |
361 |
|
|
elsif ($elem eq 'struct') |
362 |
|
|
{ |
363 |
|
|
# Create the hash table in-place, then pass the ref to the constructor |
364 |
|
|
$list = {}; |
365 |
|
|
# First off the stack needs to be STRUCTMEM or STRUCT |
366 |
|
|
return stack_error($robj, $self, $elem) |
367 |
|
|
unless ($op == STRUCTMEM or $op == STRUCT); |
368 |
|
|
while ($op == STRUCTMEM) |
369 |
|
|
{ |
370 |
|
|
# Next on stack (in list-order): name, value |
371 |
|
|
($name, $obj) = splice(@{$robj->{stack}}, -2); |
372 |
|
|
$list->{$name} = $obj; |
373 |
|
|
$op = pop(@{$robj->{stack}}); |
374 |
|
|
} |
375 |
|
|
# Now that we see something ! STRUCTMEM, it needs to be STRUCT |
376 |
|
|
return stack_error($robj, $self, $elem) unless ($op == STRUCT); |
377 |
|
|
$obj = RPC::XML::struct->new($list); |
378 |
|
|
return error($robj, $self, |
379 |
|
|
'Error creating a RPC::XML::struct object: ' . |
380 |
|
|
$RPC::XML::ERROR) |
381 |
|
|
unless $obj; |
382 |
|
|
push(@{$robj->{stack}}, $obj, DATAOBJECT); |
383 |
|
|
} |
384 |
|
|
elsif ($elem eq 'array') |
385 |
|
|
{ |
386 |
|
|
# This is similar in most ways to struct creation, save for the lack |
387 |
|
|
# of naming for the elements. |
388 |
|
|
# Create the list in-place, then pass the ref to the constructor |
389 |
|
|
$list = []; |
390 |
|
|
# Only DATAOBJECT or ARRAY should be visible |
391 |
|
|
return stack_error($robj, $self, $elem) |
392 |
|
|
unless ($op == DATAOBJECT or $op == ARRAY); |
393 |
|
|
while ($op == DATAOBJECT) |
394 |
|
|
{ |
395 |
|
|
unshift(@$list, pop(@{$robj->{stack}})); |
396 |
|
|
$op = pop(@{$robj->{stack}}); |
397 |
|
|
} |
398 |
|
|
# Now that we see something ! DATAOBJECT, it needs to be ARRAY |
399 |
|
|
return stack_error($robj, $self, $elem) unless ($op == ARRAY); |
400 |
|
|
$obj = RPC::XML::array->new($list); |
401 |
|
|
return error($robj, $self, |
402 |
|
|
'Error creating a RPC::XML::array object: ' . |
403 |
|
|
$RPC::XML::ERROR) |
404 |
|
|
unless $obj; |
405 |
|
|
push(@{$robj->{stack}}, $obj, DATAOBJECT); |
406 |
|
|
} |
407 |
|
|
elsif ($elem eq 'methodName') |
408 |
|
|
{ |
409 |
|
|
return error($robj, $self, |
410 |
|
|
"<$elem> tag must immediately follow a <methodCall> tag") |
411 |
|
|
unless ($robj->{stack}->[$#{$robj->{stack}}] == METHOD); |
412 |
|
|
push(@{$robj->{stack}}, $robj->{cdata}, NAMEVAL); |
413 |
|
|
} |
414 |
|
|
elsif ($elem eq 'methodCall') |
415 |
|
|
{ |
416 |
|
|
# A methodCall closing should have on the stack an optional PARAMLIST |
417 |
|
|
# marker, a NAMEVAL marker, then the METHOD token from the |
418 |
|
|
# opening tag. An ATTR_SET may follow the METHOD token. |
419 |
|
|
if ($op == PARAMLIST) |
420 |
|
|
{ |
421 |
|
|
($op, $list) = splice(@{$robj->{stack}}, -2); |
422 |
|
|
} |
423 |
|
|
else |
424 |
|
|
{ |
425 |
|
|
$list = []; |
426 |
|
|
} |
427 |
|
|
if ($op == NAMEVAL) |
428 |
|
|
{ |
429 |
|
|
($op, $name) = splice(@{$robj->{stack}}, -2); |
430 |
|
|
} |
431 |
|
|
return error($robj, $self, |
432 |
|
|
"No methodName tag detected during methodCall parsing") |
433 |
|
|
unless $name; |
434 |
|
|
return stack_error($robj, $self, $elem) unless ($op == METHOD); |
435 |
|
|
# Create the request object and push it on the stack |
436 |
|
|
$obj = RPC::XML::request->new($name, @$list); |
437 |
|
|
return error($robj, $self, |
438 |
|
|
"Error creating request object: $RPC::XML::ERROR") |
439 |
|
|
unless $obj; |
440 |
|
|
push(@{$robj->{stack}}, $obj, METHODENT); |
441 |
|
|
} |
442 |
|
|
elsif ($elem eq 'methodResponse') |
443 |
|
|
{ |
444 |
|
|
# A methodResponse closing should have on the stack only the |
445 |
|
|
# DATAOBJECT marker, then the RESPONSE token from the opening tag. |
446 |
|
|
if ($op == PARAMLIST) |
447 |
|
|
{ |
448 |
|
|
# To my knowledge, the XML-RPC spec limits the params list for |
449 |
|
|
# a response to exactly one object. Extract it from the listref |
450 |
|
|
# and put it back. |
451 |
|
|
$list = pop(@{$robj->{stack}}); |
452 |
|
|
return error($robj, $self, |
453 |
|
|
"Params list for <$elem> tag invalid") |
454 |
|
|
unless (@$list == 1); |
455 |
|
|
$obj = $list->[0]; |
456 |
|
|
return error($robj, $self, |
457 |
|
|
"Returned value on stack not a type reference") |
458 |
|
|
unless (ref $obj and $obj->isa('RPC::XML::datatype')); |
459 |
|
|
push(@{$robj->{stack}}, $obj); |
460 |
|
|
} |
461 |
|
|
elsif (! ($op == DATAOBJECT or $op == FAULTENT)) |
462 |
|
|
{ |
463 |
|
|
return error($robj, $self, |
464 |
|
|
"No parameter was declared for the <$elem> tag"); |
465 |
|
|
} |
466 |
|
|
($op, $list) = splice(@{$robj->{stack}}, -2); |
467 |
|
|
return stack_error($robj, $self, $elem) unless ($op == RESPONSE); |
468 |
|
|
# Create the response object and push it on the stack |
469 |
|
|
$obj = RPC::XML::response->new($list); |
470 |
|
|
return error($robj, $self, |
471 |
|
|
"Error creating response object: $RPC::XML::ERROR") |
472 |
|
|
unless $obj; |
473 |
|
|
push(@{$robj->{stack}}, $obj, RESPONSEENT); |
474 |
|
|
} |
475 |
|
|
} |
476 |
|
|
|
477 |
|
|
# This just spools the character data until a closing tag makes use of it |
478 |
|
|
sub char_data |
479 |
|
|
{ |
480 |
|
|
my $robj = shift; |
481 |
|
|
my $self = shift; |
482 |
|
|
my $data = shift; |
483 |
|
|
|
484 |
|
|
$robj->{cdata} .= $data; |
485 |
|
|
} |
486 |
|
|
|
487 |
|
|
__END__ |
488 |
|
|
|
489 |
|
|
=head1 NAME |
490 |
|
|
|
491 |
|
|
RPC::XML::Parser - A container class for XML::Parser |
492 |
|
|
|
493 |
|
|
=head1 SYNOPSIS |
494 |
|
|
|
495 |
|
|
use RPC::XML::Parser; |
496 |
|
|
... |
497 |
|
|
$P = RPC::XML::Parser->new(); |
498 |
|
|
$P->parse($message); |
499 |
|
|
|
500 |
|
|
=head1 DESCRIPTION |
501 |
|
|
|
502 |
|
|
The B<RPC::XML::Parser> class encapsulates the parsing process, for turning a |
503 |
|
|
string or an input stream into a B<RPC::XML::request> or B<RPC::XML::response> |
504 |
|
|
object. The B<XML::Parser> class is used internally, with a new instance |
505 |
|
|
created for each call to C<parse> (detailed below). This allows the |
506 |
|
|
B<RPC::XML::Parser> object to be reusable, even though the B<XML::Parser> |
507 |
|
|
objects are not. The methods are: |
508 |
|
|
|
509 |
|
|
=over 4 |
510 |
|
|
|
511 |
|
|
=item new |
512 |
|
|
|
513 |
|
|
Create a new instance of the class. Any extra data passed to the constructor |
514 |
|
|
is taken as key/value pairs (B<not> a hash reference) and attached to the |
515 |
|
|
object. |
516 |
|
|
|
517 |
|
|
=item parse { STRING | STREAM } |
518 |
|
|
|
519 |
|
|
Parse the XML document specified in either a string or a stream. The stream |
520 |
|
|
may be any file descriptor, derivative of B<IO::Handle>, etc. The return |
521 |
|
|
value is either an object reference (to one of B<RPC::XML::request> or |
522 |
|
|
B<RPC::XML::response>) or an error string. Any non-reference return value |
523 |
|
|
should be treated as an error condition. |
524 |
|
|
|
525 |
|
|
=back |
526 |
|
|
|
527 |
|
|
=head1 DIAGNOSTICS |
528 |
|
|
|
529 |
|
|
The constructor returns C<undef> upon failure, with the error message available |
530 |
|
|
in the global variable B<C<$RPC::XML::ERROR>>. |
531 |
|
|
|
532 |
|
|
=head1 CAVEATS |
533 |
|
|
|
534 |
|
|
This began as a reference implementation in which clarity of process and |
535 |
|
|
readability of the code took precedence over general efficiency. It is now |
536 |
|
|
being maintained as production code, but may still have parts that could be |
537 |
|
|
written more efficiently. |
538 |
|
|
|
539 |
|
|
=head1 CREDITS |
540 |
|
|
|
541 |
|
|
The B<XML-RPC> standard is Copyright (c) 1998-2001, UserLand Software, Inc. |
542 |
|
|
See <http://www.xmlrpc.com> for more information about the B<XML-RPC> |
543 |
|
|
specification. |
544 |
|
|
|
545 |
|
|
=head1 LICENSE |
546 |
|
|
|
547 |
|
|
This module is licensed under the terms of the Artistic License that covers |
548 |
|
|
Perl. See <http://language.perl.com/misc/Artistic.html> for the |
549 |
|
|
license itself. |
550 |
|
|
|
551 |
|
|
=head1 SEE ALSO |
552 |
|
|
|
553 |
|
|
L<RPC::XML>, L<RPC::XML::Client>, L<RPC::XML::Server>, L<XML::Parser> |
554 |
|
|
|
555 |
|
|
=head1 AUTHOR |
556 |
|
|
|
557 |
|
|
Randy J. Ray <rjray@blackperl.com> |
558 |
|
|
|
559 |
|
|
=cut |