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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 279 - (download) (as text) (annotate)
Fri May 17 21:44:04 2002 UTC (17 years, 3 months ago) by gage
File size: 10906 byte(s)
Experimental xmlrpc WeBWorK webservices

    1 ###############################################################################
    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