[system] / trunk / xmlrpc / RPC / RPC-XML-0.25 / lib / RPC / XML / Client.pm Repository:
ViewVC logotype

Annotation of /trunk/xmlrpc/RPC/RPC-XML-0.25/lib/RPC/XML/Client.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : gage 279 ###############################################################################
2 :     #
3 :     # This file copyright (c) 2001 by Randy J. Ray <rjray@blackperl.com>,
4 :     # all rights reserved
5 :     #
6 :     # Copying and distribution are permitted under the terms of the Artistic
7 :     # License as distributed with Perl versions 5.002 and later. See
8 :     # http://language.perl.com/misc/Artistic.html
9 :     #
10 :     ###############################################################################
11 :     #
12 :     # $Id$
13 :     #
14 :     # Description: This class implements an RPC::XML client, using LWP to
15 :     # manage the underlying communication protocols. It relies
16 :     # on the RPC::XML transaction core for data management.
17 :     #
18 :     # Functions: new
19 :     # send_request
20 :     # simple_request
21 :     # uri
22 :     # useragent
23 :     # request
24 :     #
25 :     # Libraries: LWP::UserAgent
26 :     # HTTP::Request
27 :     # URI
28 :     # RPC::XML
29 :     #
30 :     # Global Consts: $VERSION
31 :     #
32 :     ###############################################################################
33 :    
34 :     package RPC::XML::Client;
35 :    
36 :     use 5.005;
37 :     use strict;
38 :     use vars qw($VERSION);
39 :     use subs qw(new send_request uri useragent request);
40 :    
41 :     require LWP::UserAgent;
42 :     require HTTP::Request;
43 :     require URI;
44 :    
45 :     require RPC::XML;
46 :     require RPC::XML::Parser;
47 :    
48 :     $VERSION = do { my @r=(q$Revision$=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
49 :    
50 :     1;
51 :    
52 :     ###############################################################################
53 :     #
54 :     # Sub Name: new
55 :     #
56 :     # Description: Create a LWP::UA instance and add some extra material
57 :     # specific to our purposes.
58 :     #
59 :     # Arguments: NAME IN/OUT TYPE DESCRIPTION
60 :     # $class in scalar Class to bless into
61 :     # $location in scalar URI path for requests to go to
62 :     # %attrs in hash Extra info
63 :     #
64 :     # Globals: $VERSION
65 :     #
66 :     # Environment: None.
67 :     #
68 :     # Returns: Success: object reference
69 :     # Failure: error string
70 :     #
71 :     ###############################################################################
72 :     sub new
73 :     {
74 :     my $class = shift;
75 :     my $location = shift;
76 :     my %attrs = @_;
77 :    
78 :     $class = ref($class) || $class;
79 :     return "${class}::new: Missing location argument" unless $location;
80 :    
81 :     my ($self, $UA, $REQ, $PARSER);
82 :    
83 :     # Start by getting the LWP::UA object
84 :     $UA = LWP::UserAgent->new() or
85 :     return "${class}::new: Unable to get LWP::UserAgent object";
86 :     $UA->agent(sprintf("%s/%s %s", $class, $VERSION, $UA->agent));
87 :     $self->{__useragent} = $UA;
88 :    
89 :     # Next get the request object for later use
90 :     $REQ = HTTP::Request->new(POST => $location) or
91 :     return "${class}::new: Unable to get HTTP::Request object";
92 :     $self->{__request} = $REQ;
93 :     $REQ->header(Content_Type => 'text/xml');
94 :    
95 :     # Preserve any attributes passed in
96 :     $self->{lc $_} = $attrs{$_} for (keys %attrs);
97 :    
98 :     # Then, get the RPC::XML::Parser instance (so that we have washed attrs)
99 :     $PARSER = RPC::XML::Parser->new() or
100 :     return "${class}::new: Unable to get RPC::XML::Parser object";
101 :     $self->{__parser} = $PARSER;
102 :    
103 :     bless $self, $class;
104 :     }
105 :    
106 :     ###############################################################################
107 :     #
108 :     # Sub Name: simple_request
109 :     #
110 :     # Description: Simplify the request process by both allowing for direct
111 :     # data on the incoming side, and for returning a native
112 :     # value rather than an object reference.
113 :     #
114 :     # Arguments: NAME IN/OUT TYPE DESCRIPTION
115 :     # $self in ref Class instance
116 :     # @args in list Various args -- see comments
117 :     #
118 :     # Globals: $RPC::XML::ERROR
119 :     #
120 :     # Environment: None.
121 :     #
122 :     # Returns: Success: value
123 :     # Failure: void return, error in $RPC::XML::ERROR
124 :     #
125 :     ###############################################################################
126 :     sub simple_request
127 :     {
128 :     my $self = shift;
129 :     my @args = @_;
130 :    
131 :     my ($return, $value);
132 :    
133 :     $RPC::XML::ERROR = '';
134 :     unless (@args == 1 and UNIVERSAL::isa($args[0], 'RPC::XML::request'))
135 :     {
136 :     # Assume that this is either data for a new request object or a set
137 :     # of objects meant to be a composite request.
138 :     $value = RPC::XML::request->new(@args);
139 :     return unless ($value); # $RPC::XML::ERROR is already set
140 :     $args[0] = $value;
141 :     }
142 :    
143 :     $return = $self->send_request($args[0]);
144 :     unless (ref $return)
145 :     {
146 :     $RPC::XML::ERROR = ref($self) . "::simple_request: $return";
147 :     return;
148 :     }
149 :     $return->value->value;
150 :     }
151 :    
152 :     ###############################################################################
153 :     #
154 :     # Sub Name: send_request
155 :     #
156 :     # Description: Take a RPC::XML::request object, dispatch a request, and
157 :     # parse the response. The return value should be a
158 :     # RPC::XML::response object, or an error string.
159 :     #
160 :     # Arguments: NAME IN/OUT TYPE DESCRIPTION
161 :     # $self in ref Class instance
162 :     # $req in ref RPC::XML::request object
163 :     #
164 :     # Globals: None.
165 :     #
166 :     # Environment: None.
167 :     #
168 :     # Returns: Success: RPC::XML::response object instance
169 :     # Failure: error string
170 :     #
171 :     ###############################################################################
172 :     sub send_request
173 :     {
174 :     my $self = shift;
175 :     my $req = shift;
176 :    
177 :     return ref($self) . '::request: Parameter in must be a RPC::XML::request'
178 :     unless (UNIVERSAL::isa($req, 'RPC::XML::request'));
179 :    
180 :     my ($respxml, $response, $reqclone);
181 :    
182 :     ($reqclone = $self->{__request}->clone)->content($req->as_string);
183 :     $reqclone->header(Host => URI->new($reqclone->uri)->host);
184 :     $response = $self->{__useragent}->request($reqclone);
185 :    
186 :     return ref($self) . '::request: HTTP server error: ' . $response->message
187 :     unless ($response->is_success);
188 :     $respxml = $response->content;
189 :    
190 :     # The return value from the parser's parse method works for us
191 :     $self->{__parser}->parse($respxml);
192 :     }
193 :    
194 :     ###############################################################################
195 :     #
196 :     # Sub Name: uri
197 :     #
198 :     # Description: Get or set the URI portion of the request
199 :     #
200 :     # Arguments: NAME IN/OUT TYPE DESCRIPTION
201 :     # $self in ref Object of this class
202 :     # $uri in scalar New URI, if passed
203 :     #
204 :     # Globals: None.
205 :     #
206 :     # Environment: None.
207 :     #
208 :     # Returns: Current URI, undef if trying to set an invalid URI
209 :     #
210 :     ###############################################################################
211 :     sub uri
212 :     {
213 :     my $self = shift;
214 :     my $uri = shift;
215 :    
216 :     $self->{__request}->uri($uri);
217 :     }
218 :    
219 :     # Accessor methods for the LWP::UserAgent and HTTP::Request objects
220 :     sub useragent { shift->{__useragent} }
221 :     sub request { shift->{__request} }
222 :    
223 :     __END__
224 :    
225 :     =pod
226 :    
227 :     =head1 NAME
228 :    
229 :     RPC::XML::Client - Sample implementation of a RPC::XML client
230 :    
231 :     =head1 SYNOPSIS
232 :    
233 :     require RPC::XML;
234 :     require RPC::XML::Client;
235 :    
236 :     $cli = new RPC::XML::Client 'http://www.localhost.net/RPCSERV';
237 :     $resp = $cli->send_request(RPC::XML::request->new('system.listMethods');
238 :    
239 :     # Assuming a successful return, should produce a well-formed XML doc
240 :     print $resp->as_string;
241 :    
242 :     =head1 DESCRIPTION
243 :    
244 :     This is a sample XML-RPC client built upon the B<RPC::XML> data classes, and
245 :     using B<LWP::UserAgent> and B<HTTP::Request> for the communication layer. This
246 :     client supports the full XML-RPC specification.
247 :    
248 :     =head1 METHODS
249 :    
250 :     The following methods are available:
251 :    
252 :     =over
253 :    
254 :     =item new (URI)
255 :    
256 :     Creates a new client object that will route its requests to the URL provided.
257 :     The constructor creates a B<HTTP::Request> object and a B<LWP::UserAgent>
258 :     object, which are stored on the client object. When requests are made, these
259 :     objects are ready to go, with the headers set appropriately. The return value
260 :     of this method is a reference to the new object. The C<URI> argument may be a
261 :     string or an object from the B<URI> class from CPAN.
262 :    
263 :     =item uri ([URI])
264 :    
265 :     Returns the B<URI> that the invoking object is set to communicate with for
266 :     requests. If a string or C<URI> class object is passed as an argument, then
267 :     the URI is set to the new value. In either case, the pre-existing value is
268 :     returned.
269 :    
270 :     =item useragent
271 :    
272 :     Returns the B<LWP::UserAgent> object instance stored on the client object.
273 :     It is not possible to assign a new such object, though direct access to it
274 :     should allow for any header modifications or other needed operations.
275 :    
276 :     =item request
277 :    
278 :     Returns the B<HTTP::Request> object. As with the above, it is not allowed to
279 :     assign a new object, but access to this value should allow for any needed
280 :     operations.
281 :    
282 :     =item simple_request (ARGS)
283 :    
284 :     This is a somewhat friendlier wrapper around the next routine
285 :     (C<send_request>) that allows for more flexibility on the input side, and
286 :     returns Perl-level data rather than an object reference. The arguments may be
287 :     the same as one would pass to the B<RPC::XML::request> constructor, or there
288 :     may be a single request object as an argument. The return value will be a
289 :     native Perl value. If the return value is C<undef>, this could be due to
290 :     either an actual return value from the request, or an error. C<simple_request>
291 :     clears the global error variable B<C<$RPC::XML::ERROR>> before the call, and
292 :     as such the developer may assume that if this variable has data upon return,
293 :     then the empty return value is due to an error.
294 :    
295 :     =item send_request (REQ)
296 :    
297 :     Sends a request to the server and attempts to parse the returned data. The
298 :     argument is an object of the B<RPC::XML::request> class, and the return value
299 :     will be either an error string or a response object. See L<RPC::XML> for
300 :     more on the response class and its methods. If the error encountered was a
301 :     run-time error within the RPC request itself, then the client will return a
302 :     response object that encapsulates a C<RPC::XML::fault> value rather than an
303 :     error string.
304 :    
305 :     =back
306 :    
307 :     =head1 DIAGNOSTICS
308 :    
309 :     All methods return some type of reference on success, or an error string on
310 :     failure. Non-reference return values should always be interpreted as errors.
311 :    
312 :     =head1 CAVEATS
313 :    
314 :     This is a reference implementation in which clarity of process and readability
315 :     of the code took precedence over general efficiency. Much, if not all, of this
316 :     can be written more compactly and/or efficiently.
317 :    
318 :     =head1 CREDITS
319 :    
320 :     The B<XML-RPC> standard is Copyright (c) 1998-2001, UserLand Software, Inc.
321 :     See <http://www.xmlrpc.com> for more information about the B<XML-RPC>
322 :     specification.
323 :    
324 :     =head1 LICENSE
325 :    
326 :     This module is licensed under the terms of the Artistic License that covers
327 :     Perl itself. See <http://language.perl.com/misc/Artistic.html> for the
328 :     license itself.
329 :    
330 :     =head1 SEE ALSO
331 :    
332 :     L<RPC::XML>, L<RPC::XML::Server>
333 :    
334 :     =head1 AUTHOR
335 :    
336 :     Randy J. Ray <rjray@blackperl.com>
337 :    
338 :     =cut

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9