[system] / trunk / xmlrpc / daemon / Frontier / RPC2.pm Repository:
ViewVC logotype

Annotation of /trunk/xmlrpc/daemon/Frontier/RPC2.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1166 - (view) (download) (as text)

1 : gage 279 #
2 :     # Copyright (C) 1998, 1999 Ken MacLeod
3 :     # Frontier::RPC is free software; you can redistribute it
4 :     # and/or modify it under the same terms as Perl itself.
5 :     #
6 :     # $Id$
7 :     #
8 :    
9 :     # NOTE: see Storable for marshalling.
10 :    
11 :     use strict;
12 :     print "Using local, doctored version of Frontier::RPC2\n";
13 :     #modified by Michael E. Gage for use with WeBWorK
14 :    
15 :    
16 :     package Frontier::RPC2;
17 :     use XML::Parser;
18 :    
19 :     use vars qw{%scalars %char_entities};
20 :    
21 :     %char_entities = (
22 :     '&' => '&',
23 :     '<' => '&lt;',
24 :     '>' => '&gt;',
25 :     '"' => '&quot;',
26 :     );
27 :    
28 :     # FIXME I need a list of these
29 :     %scalars = (
30 :     'base64' => 1,
31 :     'boolean' => 1,
32 :     'dateTime.iso8601' => 1,
33 :     'double' => 1,
34 :     'int' => 1,
35 :     'i4' => 1,
36 :     'string' => 1,
37 :     );
38 :    
39 :     sub new {
40 :     my $class = shift;
41 :     my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
42 :    
43 :     bless $self, $class;
44 :    
45 :     if (defined $self->{'encoding'}) {
46 :     $self->{'encoding_'} = " encoding=\"$self->{'encoding'}\"";
47 :     } else {
48 :     $self->{'encoding_'} = "";
49 :     }
50 :    
51 :     return $self;
52 :     }
53 :    
54 :     sub encode_call {
55 :     my $self = shift; my $proc = shift;
56 :    
57 :     my @text;
58 :     push @text, <<EOF;
59 :     <?xml version="1.0"$self->{'encoding_'}?>
60 :     <methodCall>
61 :     <methodName>$proc</methodName>
62 :     <params>
63 :     EOF
64 :    
65 :     push @text, $self->_params([@_]);
66 :    
67 :     push @text, <<EOF;
68 :     </params>
69 :     </methodCall>
70 :     EOF
71 :    
72 :     return join('', @text);
73 :     }
74 :    
75 :     sub encode_response {
76 :     my $self = shift;
77 :    
78 :     my @text;
79 :     push @text, <<EOF;
80 :     <?xml version="1.0"$self->{'encoding_'}?>
81 :     <methodResponse>
82 :     <params>
83 :     EOF
84 :    
85 :     push @text, $self->_params([@_]);
86 :    
87 :     push @text, <<EOF;
88 :     </params>
89 :     </methodResponse>
90 :     EOF
91 :    
92 :     return join('', @text);
93 :     }
94 :    
95 :     sub encode_fault {
96 :     my $self = shift; my $code = shift; my $message = shift;
97 :    
98 :     my @text;
99 :     push @text, <<EOF;
100 :     <?xml version="1.0"$self->{'encoding_'}?>
101 :     <methodResponse>
102 :     <fault>
103 :     EOF
104 :    
105 :     push @text, $self->_item({faultCode => $code, faultString => $message});
106 :    
107 :     push @text, <<EOF;
108 :     </fault>
109 :     </methodResponse>
110 :     EOF
111 :    
112 :     return join('', @text);
113 :     }
114 :    
115 :     sub serve {
116 :     my $self = shift; my $xml = shift; my $methods = shift;
117 :    
118 :     my $call;
119 :     # FIXME bug in Frontier's XML
120 :     $xml =~ s/(<\?XML\s+VERSION)/\L$1\E/;
121 :     eval { $call = $self->decode($xml) };
122 :    
123 :     if ($@) {
124 :     return $self->encode_fault(1, "error decoding RPC.\n" . $@);
125 :     }
126 :    
127 :     if ($call->{'type'} ne 'call') {
128 :     return $self->encode_fault(2,"expected RPC \`methodCall', got \`$call->{'type'}'\n");
129 :     }
130 :    
131 :     my $method = $call->{'method_name'};
132 :     if (!defined $methods->{$method}) {
133 :     return $self->encode_fault(3, "no such method \`$method'\n");
134 :     }
135 :    
136 :     my $result;
137 :     my $eval = eval { $result = &{ $methods->{$method} }(@{ $call->{'value'} }) };
138 :     if ($@) {
139 :     return $self->encode_fault(4, "error executing RPC \`$method'.\n" . $@);
140 :     }
141 :    
142 :     my $response_xml = $self->encode_response($result);
143 :     return $response_xml;
144 :     }
145 :    
146 :     sub _params {
147 :     my $self = shift; my $array = shift;
148 :    
149 :     my @text;
150 :    
151 :     my $item;
152 :     foreach $item (@$array) {
153 :     push (@text, "<param>",
154 :     $self->_item($item),
155 :     "</param>\n");
156 :     }
157 :    
158 :     return @text;
159 :     }
160 :    
161 :     sub _item {
162 :     my $self = shift; my $item = shift;
163 :    
164 :     my @text;
165 :     my $ref = ref($item);
166 :     if (!$ref) {
167 :     push (@text, $self->_scalar ($item));
168 :     } elsif ($ref eq 'ARRAY') {
169 :     push (@text, $self->_array($item));
170 :     } elsif ($ref eq 'HASH') { # "$item" is more general than using ref($item) it will for example convert answer hashes.
171 :     push (@text, $self->_hash($item));
172 :     } elsif ($ref eq 'AnswerHash') {
173 :     push (@text, $self->_hash($item));
174 :     } elsif ("$item" =~/CODE|HASH/) {
175 :     push @text, "<value><string>$item</string></value>\n";
176 :     } elsif ($ref eq 'Frontier::RPC2::Boolean') {
177 :     push @text, "<value><boolean>", $item->repr, "</boolean></value>\n";
178 :     } elsif ($ref eq 'Frontier::RPC2::String') {
179 :     push @text, "<value><string>", $item->repr, "</string></value>\n";
180 :     } elsif ($ref eq 'Frontier::RPC2::Integer') {
181 :     push @text, "<value><int>", $item->repr, "</int></value>\n";
182 :     } elsif ($ref eq 'Frontier::RPC2::Double') {
183 : gage 1166 push @text, "<value><double>", $item->repr, "</double></value>\n";
184 : gage 279 } elsif ($ref eq 'Frontier::RPC2::DateTime::ISO8601') {
185 :     push @text, "<value><dateTime.iso8601>", $item->repr, "</dateTime.iso8601></value>\n";
186 :     } elsif ($ref eq 'Frontier::RPC2::Base64') {
187 :     push @text, "<value><base64>", $item->repr, "</base64></value>\n";
188 :     } elsif ($ref eq 'Complex1') {
189 :     push @text, "<value><string>$item</string></value>\n";
190 :     } else {
191 :     push @text, "<value><string>", "Don't recognize $item ", "</string></value>\n";
192 :     #die "can't convert \`$item' to XML\n";
193 :     }
194 :    
195 :     return @text;
196 :     }
197 :    
198 :     sub _hash {
199 :     my $self = shift; my $hash = shift;
200 :    
201 :     my @text = "<value><struct>\n";
202 :    
203 :     my ($key, $value);
204 :     while (($key, $value) = each %$hash) {
205 :     push (@text,
206 :     "<member><name>$key</name>",
207 :     $self->_item($value),
208 :     "</member>\n");
209 :     }
210 :    
211 :     push @text, "</struct></value>\n";
212 :    
213 :     return @text;
214 :     }
215 :    
216 :    
217 :     sub _array {
218 :     my $self = shift; my $array = shift;
219 :    
220 :     my @text = "<value><array><data>\n";
221 :    
222 :     my $item;
223 :     foreach $item (@$array) {
224 :     push @text, $self->_item($item);
225 :     }
226 :    
227 :     push @text, "</data></array></value>\n";
228 :    
229 :     return @text;
230 :     }
231 :    
232 :     sub _scalar {
233 :     my $self = shift; my $value = shift;
234 : gage 681 $value = '' unless defined($value); # hack -- is this necessary? desirable?
235 : gage 279 # these are from `perldata(1)'
236 :     if ($value =~ /^[+-]?\d+$/) {
237 : gage 1166 # return ("<value><i4>$value</i4></value>"); # doesn't seem right
238 :     return ("<value><int>$value</int></value>");
239 : gage 279 } elsif ($value =~ /^(-?(?:\d+(?:\.\d*)?|\.\d+)|([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)$/) {
240 : gage 1166 # return ("<value><double>".sprintf('%0.13f',$value)."</double></value>"); # Frontier can't handle exponential notation
241 :     return ("<value><string>".sprintf('%0.13f',$value)."</string></value>"); # Frontier can't handle exponential notation
242 : gage 279 #return ("<value><double>$value</double></value>");
243 :     } else {
244 :     $value =~ s/([&<>\"])/$char_entities{$1}/ge;
245 :     return ("<value><string>$value</string></value>");
246 :     }
247 :     }
248 :    
249 :     sub decode {
250 :     my $self = shift; my $string = shift;
251 :    
252 :     $self->{'parser'} = new XML::Parser Style => ref($self);
253 :     return $self->{'parser'}->parsestring($string);
254 :     }
255 :    
256 :     # shortcuts
257 :     sub base64 {
258 :     my $self = shift;
259 :    
260 :     return Frontier::RPC2::Base64->new(@_);
261 :     }
262 :    
263 :     sub boolean {
264 :     my $self = shift;
265 :     my $elem = shift;
266 :     if($elem == 0 or $elem == 1) {
267 :     return Frontier::RPC2::Boolean->new($elem);
268 :     } else {
269 :     die "error in rendering RPC type \`$elem\' not a boolean\n";
270 :     }
271 :     }
272 :    
273 :     sub double {
274 :     my $self = shift;
275 :     my $elem = shift;
276 :     # this is from `perldata(1)'
277 :     if($elem =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
278 :     return Frontier::RPC2::Double->new($elem);
279 :     } else {
280 :     die "error in rendering RPC type \`$elem\' not a double\n";
281 :     }
282 :     }
283 :    
284 :     sub int {
285 :     my $self = shift;
286 :     my $elem = shift;
287 :     # this is from `perldata(1)'
288 :     if($elem =~ /^[+-]?\d+$/) {
289 :     return Frontier::RPC2::Integer->new($elem);
290 :     } else {
291 :     die "error in rendering RPC type \`$elem\' not an int\n";
292 :     }
293 :     }
294 :    
295 :     sub string {
296 :     my $self = shift;
297 :    
298 :     return Frontier::RPC2::String->new(@_);
299 :     }
300 :    
301 :     sub date_time {
302 :     my $self = shift;
303 :    
304 :     return Frontier::RPC2::DateTime::ISO8601->new(@_);
305 :     }
306 :    
307 :     ######################################################################
308 :     ###
309 :     ### XML::Parser callbacks
310 :     ###
311 :    
312 :     sub die {
313 :     my $parser = shift; my $message = shift;
314 :    
315 :     die $message
316 :     . "at line " . $parser->current_line
317 :     . " column " . $parser->current_column . "\n";
318 :     }
319 :    
320 :     sub init {
321 :     my $self = shift;
322 :    
323 :     $self->{'rpc_state'} = [];
324 :     $self->{'rpc_container'} = [ [] ];
325 :     $self->{'rpc_member_name'} = [];
326 :     $self->{'rpc_type'} = undef;
327 :     $self->{'rpc_args'} = undef;
328 :     }
329 :    
330 :     # FIXME this state machine wouldn't be necessary if we had a DTD.
331 :     sub start {
332 :     my $self = shift; my $tag = shift;
333 :    
334 :     my $state = $self->{'rpc_state'}[-1];
335 :    
336 :     if (!defined $state) {
337 :     if ($tag eq 'methodCall') {
338 :     $self->{'rpc_type'} = 'call';
339 :     push @{ $self->{'rpc_state'} }, 'want_method_name';
340 :     } elsif ($tag eq 'methodResponse') {
341 :     push @{ $self->{'rpc_state'} }, 'method_response';
342 :     } else {
343 :     Frontier::RPC2::die($self, "unknown RPC type \`$tag'\n");
344 :     }
345 :     } elsif ($state eq 'want_method_name') {
346 :     Frontier::RPC2::die($self, "wanted \`methodName' tag, got \`$tag'\n")
347 :     if ($tag ne 'methodName');
348 :     push @{ $self->{'rpc_state'} }, 'method_name';
349 :     $self->{'rpc_text'} = "";
350 :     } elsif ($state eq 'method_response') {
351 :     if ($tag eq 'params') {
352 :     $self->{'rpc_type'} = 'response';
353 :     push @{ $self->{'rpc_state'} }, 'params';
354 :     } elsif ($tag eq 'fault') {
355 :     $self->{'rpc_type'} = 'fault';
356 :     push @{ $self->{'rpc_state'} }, 'want_value';
357 :     }
358 :     } elsif ($state eq 'want_params') {
359 :     Frontier::RPC2::die($self, "wanted \`params' tag, got \`$tag'\n")
360 :     if ($tag ne 'params');
361 :     push @{ $self->{'rpc_state'} }, 'params';
362 :     } elsif ($state eq 'params') {
363 :     Frontier::RPC2::die($self, "wanted \`param' tag, got \`$tag'\n")
364 :     if ($tag ne 'param');
365 :     push @{ $self->{'rpc_state'} }, 'want_param_name_or_value';
366 :     } elsif ($state eq 'want_param_name_or_value') {
367 :     if ($tag eq 'value') {
368 :     $self->{'may_get_cdata'} = 1;
369 :     $self->{'rpc_text'} = "";
370 :     push @{ $self->{'rpc_state'} }, 'value';
371 :     } elsif ($tag eq 'name') {
372 :     push @{ $self->{'rpc_state'} }, 'param_name';
373 :     } else {
374 :     Frontier::RPC2::die($self, "wanted \`value' or \`name' tag, got \`$tag'\n");
375 :     }
376 :     } elsif ($state eq 'param_name') {
377 :     Frontier::RPC2::die($self, "wanted parameter name data, got tag \`$tag'\n");
378 :     } elsif ($state eq 'want_value') {
379 :     Frontier::RPC2::die($self, "wanted \`value' tag, got \`$tag'\n")
380 :     if ($tag ne 'value');
381 :     $self->{'rpc_text'} = "";
382 :     $self->{'may_get_cdata'} = 1;
383 :     push @{ $self->{'rpc_state'} }, 'value';
384 :     } elsif ($state eq 'value') {
385 :     $self->{'may_get_cdata'} = 0;
386 :     if ($tag eq 'array') {
387 :     push @{ $self->{'rpc_container'} }, [];
388 :     push @{ $self->{'rpc_state'} }, 'want_data';
389 :     } elsif ($tag eq 'struct') {
390 :     push @{ $self->{'rpc_container'} }, {};
391 :     push @{ $self->{'rpc_member_name'} }, undef;
392 :     push @{ $self->{'rpc_state'} }, 'struct';
393 :     } elsif ($scalars{$tag}) {
394 :     $self->{'rpc_text'} = "";
395 :     push @{ $self->{'rpc_state'} }, 'cdata';
396 :     } else {
397 :     Frontier::RPC2::die($self, "wanted a data type, got \`$tag'\n");
398 :     }
399 :     } elsif ($state eq 'want_data') {
400 :     Frontier::RPC2::die($self, "wanted \`data', got \`$tag'\n")
401 :     if ($tag ne 'data');
402 :     push @{ $self->{'rpc_state'} }, 'array';
403 :     } elsif ($state eq 'array') {
404 :     Frontier::RPC2::die($self, "wanted \`value' tag, got \`$tag'\n")
405 :     if ($tag ne 'value');
406 :     $self->{'rpc_text'} = "";
407 :     $self->{'may_get_cdata'} = 1;
408 :     push @{ $self->{'rpc_state'} }, 'value';
409 :     } elsif ($state eq 'struct') {
410 :     Frontier::RPC2::die($self, "wanted \`member' tag, got \`$tag'\n")
411 :     if ($tag ne 'member');
412 :     push @{ $self->{'rpc_state'} }, 'want_member_name';
413 :     } elsif ($state eq 'want_member_name') {
414 :     Frontier::RPC2::die($self, "wanted \`name' tag, got \`$tag'\n")
415 :     if ($tag ne 'name');
416 :     push @{ $self->{'rpc_state'} }, 'member_name';
417 :     $self->{'rpc_text'} = "";
418 :     } elsif ($state eq 'member_name') {
419 :     Frontier::RPC2::die($self, "wanted data, got tag \`$tag'\n");
420 :     } elsif ($state eq 'cdata') {
421 :     Frontier::RPC2::die($self, "wanted data, got tag \`$tag'\n");
422 :     } else {
423 :     Frontier::RPC2::die($self, "internal error, unknown state \`$state'\n");
424 :     }
425 :     }
426 :    
427 :     sub end {
428 :     my $self = shift; my $tag = shift;
429 :    
430 :     my $state = pop @{ $self->{'rpc_state'} };
431 :    
432 :     if ($state eq 'cdata') {
433 :     my $value = $self->{'rpc_text'};
434 :     if ($tag eq 'base64') {
435 :     $value = Frontier::RPC2::Base64->new($value);
436 :     } elsif ($tag eq 'boolean') {
437 :     $value = Frontier::RPC2::Boolean->new($value);
438 :     } elsif ($tag eq 'dateTime.iso8601') {
439 :     $value = Frontier::RPC2::DateTime::ISO8601->new($value);
440 :     } elsif ($self->{'use_objects'}) {
441 :     if ($tag eq 'i4') {
442 :     $value = Frontier::RPC2::Integer->new($value);
443 :     } elsif ($tag eq 'float') {
444 :     $value = Frontier::RPC2::Float->new($value);
445 :     } elsif ($tag eq 'string') {
446 :     $value = Frontier::RPC2::String->new($value);
447 :     }
448 :     }
449 :     $self->{'rpc_value'} = $value;
450 :     } elsif ($state eq 'member_name') {
451 :     $self->{'rpc_member_name'}[-1] = $self->{'rpc_text'};
452 :     $self->{'rpc_state'}[-1] = 'want_value';
453 :     } elsif ($state eq 'method_name') {
454 :     $self->{'rpc_method_name'} = $self->{'rpc_text'};
455 :     $self->{'rpc_state'}[-1] = 'want_params';
456 :     } elsif ($state eq 'struct') {
457 :     $self->{'rpc_value'} = pop @{ $self->{'rpc_container'} };
458 :     pop @{ $self->{'rpc_member_name'} };
459 :     } elsif ($state eq 'array') {
460 :     $self->{'rpc_value'} = pop @{ $self->{'rpc_container'} };
461 :     } elsif ($state eq 'value') {
462 :     # the rpc_text is a string if no type tags were given
463 :     if ($self->{'may_get_cdata'}) {
464 :     $self->{'may_get_cdata'} = 0;
465 :     if ($self->{'use_objects'}) {
466 :     $self->{'rpc_value'}
467 :     = Frontier::RPC2::String->new($self->{'rpc_text'});
468 :     } else {
469 :     $self->{'rpc_value'} = $self->{'rpc_text'};
470 :     }
471 :     }
472 :     my $container = $self->{'rpc_container'}[-1];
473 :     if (ref($container) eq 'ARRAY') {
474 :     push @$container, $self->{'rpc_value'};
475 :     } elsif (ref($container) eq 'HASH') {
476 :     $container->{ $self->{'rpc_member_name'}[-1] } = $self->{'rpc_value'};
477 :     }
478 :     }
479 :     }
480 :    
481 :     sub char {
482 :     my $self = shift; my $text = shift;
483 :    
484 :     $self->{'rpc_text'} .= $text;
485 :     }
486 :    
487 :     sub proc {
488 :     }
489 :    
490 :     sub final {
491 :     my $self = shift;
492 :    
493 :     $self->{'rpc_value'} = pop @{ $self->{'rpc_container'} };
494 :    
495 :     return {
496 :     value => $self->{'rpc_value'},
497 :     type => $self->{'rpc_type'},
498 :     method_name => $self->{'rpc_method_name'},
499 :     };
500 :     }
501 :    
502 :     package Frontier::RPC2::DataType;
503 :    
504 :     sub new {
505 :     my $type = shift; my $value = shift;
506 :    
507 :     return bless \$value, $type;
508 :     }
509 :    
510 :     # `repr' returns the XML representation of this data, which may be
511 :     # different [in the future] from what is returned from `value'
512 :     sub repr {
513 :     my $self = shift;
514 :    
515 :     return $$self;
516 :     }
517 :    
518 :     # sets or returns the usable value of this data
519 :     sub value {
520 :     my $self = shift;
521 :     @_ ? ($$self = shift) : $$self;
522 :     }
523 :    
524 :     package Frontier::RPC2::Base64;
525 :    
526 :     use vars qw{@ISA};
527 :     @ISA = qw{Frontier::RPC2::DataType};
528 :    
529 :     package Frontier::RPC2::Boolean;
530 :    
531 :     use vars qw{@ISA};
532 :     @ISA = qw{Frontier::RPC2::DataType};
533 :    
534 :     package Frontier::RPC2::Integer;
535 :    
536 :     use vars qw{@ISA};
537 :     @ISA = qw{Frontier::RPC2::DataType};
538 :    
539 :     package Frontier::RPC2::String;
540 :    
541 :     use vars qw{@ISA};
542 :     @ISA = qw{Frontier::RPC2::DataType};
543 :    
544 :     package Frontier::RPC2::Double;
545 :    
546 :     use vars qw{@ISA};
547 :     @ISA = qw{Frontier::RPC2::DataType};
548 :    
549 :     package Frontier::RPC2::DateTime::ISO8601;
550 :    
551 :     use vars qw{@ISA};
552 :     @ISA = qw{Frontier::RPC2::DataType};
553 :    
554 :     =head1 NAME
555 :    
556 :     Frontier::RPC2 - encode/decode RPC2 format XML
557 :    
558 :     =head1 SYNOPSIS
559 :    
560 :     use Frontier::RPC2;
561 :    
562 :     $coder = Frontier::RPC2->new;
563 :    
564 :     $xml_string = $coder->encode_call($method, @args);
565 :     $xml_string = $coder->encode_response($result);
566 :     $xml_string = $coder->encode_fault($code, $message);
567 :    
568 :     $call = $coder->decode($xml_string);
569 :    
570 :     $response_xml = $coder->serve($request_xml, $methods);
571 :    
572 :     $boolean_object = $coder->boolean($boolean);
573 :     $date_time_object = $coder->date_time($date_time);
574 :     $base64_object = $coder->base64($base64);
575 :     $int_object = $coder->int(42);
576 :     $float_object = $coder->float(3.14159);
577 :     $string_object = $coder->string("Foo");
578 :    
579 :     =head1 DESCRIPTION
580 :    
581 :     I<Frontier::RPC2> encodes and decodes XML RPC calls.
582 :    
583 :     =over 4
584 :    
585 :     =item $coder = Frontier::RPC2->new( I<OPTIONS> )
586 :    
587 :     Create a new encoder/decoder. The following option is supported:
588 :    
589 :     =over 4
590 :    
591 :     =item encoding
592 :    
593 :     The XML encoding to be specified in the XML declaration of encoded RPC
594 :     requests or responses. Decoded results may have a different encoding
595 :     specified; XML::Parser will convert decoded data to UTF-8. The
596 :     default encoding is none, which uses XML 1.0's default of UTF-8. For
597 :     example:
598 :    
599 :     $server = Frontier::RPC2->new( 'encoding' => 'ISO-8859-1' );
600 :    
601 :     =item use_objects
602 :    
603 :     If set to a non-zero value will convert incoming E<lt>i4E<gt>,
604 :     E<lt>floatE<gt>, and E<lt>stringE<gt> values to objects instead of
605 :     scalars. See int(), float(), and string() below for more details.
606 :    
607 :     =back
608 :    
609 :     =item $xml_string = $coder->encode_call($method, @args)
610 :    
611 :     `C<encode_call>' converts a method name and it's arguments into an
612 :     RPC2 `C<methodCall>' element, returning the XML fragment.
613 :    
614 :     =item $xml_string = $coder->encode_response($result)
615 :    
616 :     `C<encode_response>' converts the return value of a procedure into an
617 :     RPC2 `C<methodResponse>' element containing the result, returning the
618 :     XML fragment.
619 :    
620 :     =item $xml_string = $coder->encode_fault($code, $message)
621 :    
622 :     `C<encode_fault>' converts a fault code and message into an RPC2
623 :     `C<methodResponse>' element containing a `C<fault>' element, returning
624 :     the XML fragment.
625 :    
626 :     =item $call = $coder->decode($xml_string)
627 :    
628 :     `C<decode>' converts an XML string containing an RPC2 `C<methodCall>'
629 :     or `C<methodResponse>' element into a hash containing three members,
630 :     `C<type>', `C<value>', and `C<method_name>'. `C<type>' is one of
631 :     `C<call>', `C<response>', or `C<fault>'. `C<value>' is array
632 :     containing the parameters or result of the RPC. For a `C<call>' type,
633 :     `C<value>' contains call's parameters and `C<method_name>' contains
634 :     the method being called. For a `C<response>' type, the `C<value>'
635 :     array contains call's result. For a `C<fault>' type, the `C<value>'
636 :     array contains a hash with the two members `C<faultCode>' and
637 :     `C<faultMessage>'.
638 :    
639 :     =item $response_xml = $coder->serve($request_xml, $methods)
640 :    
641 :     `C<serve>' decodes `C<$request_xml>', looks up the called method name
642 :     in the `C<$methods>' hash and calls it, and then encodes and returns
643 :     the response as XML.
644 :    
645 :     =item $boolean_object = $coder->boolean($boolean);
646 :    
647 :     =item $date_time_object = $coder->date_time($date_time);
648 :    
649 :     =item $base64_object = $coder->base64($base64);
650 :    
651 :     These methods create and return XML-RPC-specific datatypes that can be
652 :     passed to the encoder. The decoder may also return these datatypes.
653 :     The corresponding package names (for use with `C<ref()>', for example)
654 :     are `C<Frontier::RPC2::Boolean>',
655 :     `C<Frontier::RPC2::DateTime::ISO8601>', and
656 :     `C<Frontier::RPC2::Base64>'.
657 :    
658 :     You can change and retrieve the value of boolean, date/time, and
659 :     base64 data using the `C<value>' method of those objects, i.e.:
660 :    
661 :     $boolean = $boolean_object->value;
662 :    
663 :     $boolean_object->value(1);
664 :    
665 :     =item $int_object = $coder->int(42);
666 :    
667 :     =item $float_object = $coder->float(3.14159);
668 :    
669 :     =item $string_object = $coder->string("Foo");
670 :    
671 :     By default, you may pass ordinary Perl values (scalars) to be encoded.
672 :     RPC2 automatically converts them to XML-RPC types if they look like an
673 :     integer, float, or as a string. This assumption causes problems when
674 :     you want to pass a string that looks like "0096", RPC2 will convert
675 :     that to an E<lt>i4E<gt> because it looks like an integer. With these
676 :     methods, you could now create a string object like this:
677 :    
678 :     $part_num = $coder->string("0096");
679 :    
680 :     and be confident that it will be passed as an XML-RPC string. You can
681 :     change and retrieve values from objects using value() as described
682 :     above.
683 :    
684 :     =back
685 :    
686 :     =head1 SEE ALSO
687 :    
688 :     perl(1), Frontier::Daemon(3), Frontier::Client(3)
689 :    
690 :     <http://www.scripting.com/frontier5/xml/code/rpc.html>
691 :    
692 :     =head1 AUTHOR
693 :    
694 :     Ken MacLeod <ken@bitsko.slc.ut.us>
695 :    
696 :     =cut
697 :    
698 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9