home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / RPC / XML / Function.pm < prev    next >
Encoding:
Perl POD Document  |  2008-04-10  |  8.9 KB  |  304 lines
  1. ###############################################################################
  2. #
  3. # This file copyright (c) 2002-2008 Randy J. Ray, all rights reserved
  4. #
  5. # See "LICENSE" in the documentation for licensing and redistribution terms.
  6. #
  7. ###############################################################################
  8. #
  9. #   $Id: Function.pm 343 2008-04-09 09:54:36Z rjray $
  10. #
  11. #   Description:    This is a type of Procedure that does no signature tests
  12. #                   at either creation or invocation.
  13. #
  14. #   Functions:      new (superclass new expects signatures)
  15. #                   signature
  16. #                   make_sig_table (called by some superclass methods)
  17. #                   clone
  18. #                   is_valid
  19. #                   match_signature
  20. #
  21. #   Libraries:      RPC::XML::Procedure (base class)
  22. #
  23. #   Global Consts:  $VERSION
  24. #
  25. #   Environment:    None
  26. #
  27. ###############################################################################
  28.  
  29. package RPC::XML::Function;
  30.  
  31. use 5.005;
  32. use strict;
  33. use vars qw($VERSION @ISA);
  34. use subs qw(new signature make_sig_table clone is_valid match_signature);
  35.  
  36. use AutoLoader 'AUTOLOAD';
  37.  
  38. require RPC::XML::Procedure;
  39.  
  40. @ISA = qw(RPC::XML::Procedure);
  41. $VERSION = '1.05';
  42.  
  43. ###############################################################################
  44. #
  45. #   Sub Name:       new
  46. #
  47. #   Description:    Create a new object of this class, storing the info on
  48. #                   regular keys (no obfuscation used here).
  49. #
  50. #   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
  51. #                   $class    in      scalar    Class to bless into
  52. #                   @argz     in      variable  Disposition is variable; see
  53. #                                                 below
  54. #
  55. #   Returns:        Success:    object ref
  56. #                   Failure:    error string
  57. #
  58. ###############################################################################
  59. sub new
  60. {
  61.     #
  62.     # This is largely a verbatim-copy of RPC::XML::Procedure::new. I plan on
  63.     # going back and coming up with a way for this class to be able to use
  64.     # the super-class new, but this is sufficient for now.
  65.     #
  66.  
  67.     my $class = shift;
  68.     my @argz  = @_;
  69.  
  70.     my $data; # This will be a hashref that eventually gets blessed
  71.  
  72.     $class = ref($class) || $class;
  73.  
  74.     #
  75.     # There are three things that @argz could be:
  76.     #
  77.     if (ref $argz[0])
  78.     {
  79.         # 1. A hashref containing all the relevant keys
  80.         $data = {};
  81.         %$data = %{$argz[0]};
  82.     }
  83.     elsif (@argz == 1)
  84.     {
  85.         # 2. Exactly one non-ref element, a file to load
  86.  
  87.         # And here is where I cheat in a way that makes even me uncomfortable.
  88.         #
  89.         # Loading code from an XPL file, it can actually be of a type other
  90.         # than how this constructor was called. So what we are going to do is
  91.         # this: If $class is undef, that can only mean that we were called
  92.         # with the intent of letting the XPL file dictate the resulting object.
  93.         # If $class is set, then we'll call load_XPL_file normally, as a
  94.         # method, to allow for subclasses to tweak things.
  95.         if (defined $class)
  96.         {
  97.             $data = $class->load_XPL_file($argz[0]);
  98.             return $data unless ref $data; # load_XPL_path signalled an error
  99.         }
  100.         else
  101.         {
  102.             # Spoofing the "class" argument to load_XPL_file makes me feel
  103.             # even dirtier...
  104.             $data = load_XPL_file(\$class, $argz[0]);
  105.             return $data unless ref $data; # load_XPL_path signalled an error
  106.             $class = "RPC::XML::$class";
  107.         }
  108.     }
  109.     else
  110.     {
  111.         # 3. If there is more than one arg, it's a sort-of-hash. That is, the
  112.         #    key 'signature' is allowed to repeat. (But this class ignores it)
  113.         my ($key, $val);
  114.         $data = {};
  115.         while (@argz)
  116.         {
  117.             ($key, $val) = splice(@argz, 0, 2);
  118.             if ($key eq 'signature')
  119.             {
  120.                 # Noop
  121.                 next;
  122.             }
  123.             elsif (exists $data->{$key})
  124.             {
  125.                 return "${class}::new: Key '$key' may not be repeated";
  126.             }
  127.             else
  128.             {
  129.                 $data->{$key} = $val;
  130.             }
  131.         }
  132.     }
  133.  
  134.     return "${class}::new: Missing required data"
  135.         unless ($data->{name} and $data->{code});
  136.     bless $data, $class;
  137. }
  138.  
  139. #
  140. # These two are only implemented here at all, because some of the logic in
  141. # other places call them
  142. #
  143. sub signature      { undef; }
  144. sub make_sig_table { $_[0]; }
  145.  
  146. 1;
  147.  
  148. =pod
  149.  
  150. =head1 NAME
  151.  
  152. RPC::XML::Function - Object class for RPC routines that do not check signatures
  153.  
  154. =head1 SYNOPSIS
  155.  
  156.     require RPC::XML::Function;
  157.  
  158.     ...
  159.     $method_1 = RPC::XML::Function->new(name => 'system.identity',
  160.                                         code => sub { ... });
  161.     $method_2 = RPC::XML::Function->new('/path/to/status.xpl');
  162.  
  163. =head1 DESCRIPTION
  164.  
  165. The B<RPC::XML::Function> is a class that derives from B<RPC::XML::Procedure>
  166. (see L<RPC::XML::Procedure>), while bypassing all the signature-specific logic
  167. associated with server-side methods in the B<RPC::XML> suite.
  168.  
  169. By doing this, the encapsulated code becomes responsible for how the server
  170. (and ultimately, the client) interprets returned values. For the classes that
  171. adhere to signatures, the signature includes the expected type of the returned
  172. value. If an object of this class anticipates that the data may be ambiguous
  173. (an intended string being interpreted as an integer, for example), the code
  174. it encapsulates should consider encoding the response with the data-classes
  175. documented in L<RPC::XML> prior to return.
  176.  
  177. =head1 USAGE
  178.  
  179. Only those routines different from B<RPC::XML::Procedure> are listed:
  180.  
  181. =over 4
  182.  
  183. =item new(LIST)
  184.  
  185. The constructor for this class is identical to the super-class versions,
  186. except that it disregards any C<signature> keys on the input list. The
  187. return value upon success is a newly-blessed object reference, otherwise
  188. an error message is returned.
  189.  
  190. =item signature
  191.  
  192. Returns C<undef> only.
  193.  
  194. =item clone
  195.  
  196. Acts as the parent C<clone> method, save that in the absence of any signature
  197. data, the clone is in fact a perfect copy of the original.
  198.  
  199. =item is_valid
  200.  
  201. Uses the same validity test, minus the checking of signature data (tests only
  202. for valid C<name> and C<code> keys).
  203.  
  204. =item match_signature
  205.  
  206. Always returns the string, C<scalar>.
  207.  
  208. =back
  209.  
  210. =head1 DIAGNOSTICS
  211.  
  212. Unless otherwises specified, routines return the object reference itself upon
  213. a successful operation, and an error string (which is not a blessed reference)
  214. upon error.
  215.  
  216. =head1 LICENSE
  217.  
  218. This module and the code within are released under the terms of the Artistic
  219. License 2.0
  220. (http://www.opensource.org/licenses/artistic-license-2.0.php). This code may
  221. be redistributed under either the Artistic License or the GNU Lesser General
  222. Public License (LGPL) version 2.1
  223. (http://www.opensource.org/licenses/lgpl-license.php).
  224.  
  225. =head1 SEE ALSO
  226.  
  227. L<RPC::XML>, L<RPC::XML::Procedure>, L<make_method>
  228.  
  229. =head1 AUTHOR
  230.  
  231. Randy J. Ray <rjray@blackperl.com>
  232.  
  233. =cut
  234.  
  235. __END__
  236.  
  237. #
  238. # These are the same as RPC::XML::Procedure subs, except that they have no
  239. # references to signatures.
  240. #
  241. ###############################################################################
  242. #
  243. #   Sub Name:       clone
  244. #
  245. #   Description:    Create a copy of the invoking object.
  246. #
  247. #   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
  248. #                   $self     in      ref       Object of this class
  249. #
  250. #   Returns:        Success:    $new_self
  251. #                   Failure:    error message
  252. #
  253. ###############################################################################
  254. sub clone
  255. {
  256.     my $self = shift;
  257.  
  258.     my $new_self = {};
  259.     %$new_self = %$self;
  260.  
  261.     bless $new_self, ref($self);
  262. }
  263.  
  264. ###############################################################################
  265. #
  266. #   Sub Name:       is_valid
  267. #
  268. #   Description:    Boolean test to tell if the calling object has sufficient
  269. #                   data to be used as a server method for RPC::XML::Server or
  270. #                   Apache::RPC::Server.
  271. #
  272. #   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
  273. #                   $self     in      ref       Object to test
  274. #
  275. #   Returns:        Success:    1, valid/complete
  276. #                   Failure:    0, invalid/incomplete
  277. #
  278. ###############################################################################
  279. sub is_valid
  280. {
  281.     my $self = shift;
  282.  
  283.     return ((ref($self->{code}) eq 'CODE') and $self->{name});
  284. }
  285.  
  286. ###############################################################################
  287. #
  288. #   Sub Name:       match_signature
  289. #
  290. #   Description:    Noop. Needed for RPC::XML::Server.
  291. #
  292. #   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
  293. #                   $self     in      ref       Object of this class
  294. #                   $sig      in      scalar    Signature to check for
  295. #
  296. #   Returns:        Success:    return type as a string
  297. #                   Failure:    0
  298. #
  299. ###############################################################################
  300. sub match_signature
  301. {
  302.     'scalar';
  303. }
  304.