FS/FS/XMLRPC.pm

   1 package FS::XMLRPC;
   2
   3 use strict;
   4 use vars qw( @ISA $DEBUG );
   5 use Frontier::RPC2;
   6
   7 # Instead of 'use'ing freeside modules on the fly below, just preload them now.
   8 use FS;
   9 use FS::CGI;
  10 use FS::Record;
  11 use FS::cust_main;
  12
  13 @ISA = qw( );
  14
  15 $DEBUG = 1;
  16
  17 =head1 NAME
  18
  19 FS::XMLRPC - Object methods for handling XMLRPC requests
  20
  21 =head1 SYNOPSIS
  22
  23   use FS::XMLRPC;
  24
  25   $xmlrpc = new FS::XMLRPC;
  26
  27   ($error, $response_xml) = $xmlrpc->serve($request_xml);
  28
  29 =head1 DESCRIPTION
  30
  31 The FS::XMLRPC object is a mechanisim to access read-only data from freeside's subroutines.  It does not, at least not at this point, give you the ability to access methods of freeside objects remotely.  It can, however, be used to call subroutines such as FS::cust_main::smart_search and FS::Record::qsearch.
  32
  33 See the serve method below for calling syntax.
  34
  35 =head1 METHODS
  36
  37 =over 4
  38
  39 =item new
  40
  41 Provides a FS::XMLRPC object used to handle incoming XMLRPC requests.
  42
  43 =cut
  44
  45 sub new {
  46
  47   my $class = shift;
  48   my $self = {};
  49   bless($self, $class);
  50
  51   $self->{_coder} = new Frontier::RPC2;
  52
  53   return $self;
  54
  55 }
  56
  57 =item serve REQUEST_XML_SCALAR
  58
  59 The serve method takes a scalar containg an XMLRPC request for one of freeside's subroutines (not object methods).  Parameters passed in the 'methodCall' will be passed as a list to the subroutine untouched.  The return value of the called subroutine _must_ be a freeside object reference (eg. qsearchs) or a list of freeside object references (eg. qsearch, smart_search), _and_, the object(s) returned must support the hashref method.  This will be checked first by calling UNIVERSAL::can('FS::class::subroutine', 'hashref').
  60
  61 Return value is an XMLRPC methodResponse containing the results of the call.  The result of the subroutine call itself will be coded in the methodResponse as an array of structs, regardless of whether there was many or a single object returned.  In other words, after you decode the response, you'll always have an array.
  62
  63 =cut
  64
  65 sub serve {
  66
  67   my ($self, $request_xml) = (shift, shift);
  68   my $response_xml;
  69
  70   my $coder = $self->{_coder};
  71   my $call = $coder->decode($request_xml);
  72
  73   warn "Got methodCall with method_name='" . $call->{method_name} . "'"
  74     if $DEBUG;
  75
  76   $response_xml = $coder->encode_response(&_serve($call->{method_name}, $call->{value}));
  77
  78   return ('', $response_xml);
  79
  80 }
  81
  82 sub _serve { #Subroutine, not method
  83
  84   my ($method_name, $params) = (shift, shift);
  85
  86   use Data::Dumper;
  87
  88   #die 'Called _serve without parameters' unless ref($params) eq 'ARRAY';
  89   $params = [] unless (ref($params) eq 'ARRAY');
  90
  91   if ($method_name =~ /^(\w+)\.(\w+)/) {
  92
  93     #my ($class, $sub) = split(/\./, $method_name);
  94     my ($class, $sub) = ($1, $2);
  95     my $fssub = "FS::${class}::${sub}";
  96     warn "fssub: ${fssub}" if $DEBUG;
  97     warn "params: " . Dumper($params) if $DEBUG;
  98
  99     unless (UNIVERSAL::can("FS::${class}", $sub)) {
 100       warn "FS::XMLRPC: Can't call undefined subroutine '${fssub}'";
 101       # Should we encode an error in the response,
 102       # or just break silently to the remote caller and complain locally?
 103       return [];
 104     }
 105
 106     my @result;
 107     eval {
 108       no strict 'refs';
 109       my $fssub = "FS::${class}::${sub}";
 110       @result = (&$fssub(@$params));
 111     };
 112
 113     if ($@) {
 114       warn "FS::XMLRPC: Error while calling '${fssub}': $@";
 115       return [];
 116     }
 117
 118     warn Dumper(@result);
 119
 120     if (grep { UNIVERSAL::can($_, 'hashref') ? 0 : 1 } @result) {
 121       #warn "FS::XMLRPC: One or more objects returned from '${fssub}' doesn't " .
 122       #     "support the 'hashref' method.";
 123
 124       # If they're not FS::Record decendants, just return the results unmap'd?
 125       # This is more flexible, but possibly more error-prone.
 126       return [ @result ];
 127     } else {
 128       return [ map { $_->hashref } @result ];
 129     }
 130   } elsif ($method_name eq 'version') {
 131     return [ $FS::VERSION ];
 132   } # else...
 133
 134   warn "Unhandle XMLRPC request '${method_name}'";
 135   return [];
 136
 137 }
 138
 139 =head1 BUGS
 140
 141 Probably lots.
 142
 143 =head1 SEE ALSO
 144
 145 L<Frontier::RPC2>.
 146
 147 =cut
 148
 149 1;
 150