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::Conf;
  11 use FS::Record;
  12 use FS::cust_main;
  13
  14 @ISA = qw( );
  15
  16 $DEBUG = 1;
  17
  18 =head1 NAME
  19
  20 FS::XMLRPC - Object methods for handling XMLRPC requests
  21
  22 =head1 SYNOPSIS
  23
  24   use FS::XMLRPC;
  25
  26   $xmlrpc = new FS::XMLRPC;
  27
  28   ($error, $response_xml) = $xmlrpc->serve($request_xml);
  29
  30 =head1 DESCRIPTION
  31
  32 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.
  33
  34 See the serve method below for calling syntax.
  35
  36 =head1 METHODS
  37
  38 =over 4
  39
  40 =item new
  41
  42 Provides a FS::XMLRPC object used to handle incoming XMLRPC requests.
  43
  44 =cut
  45
  46 sub new {
  47
  48   my $class = shift;
  49   my $self = {};
  50   bless($self, $class);
  51
  52   $self->{_coder} = new Frontier::RPC2;
  53
  54   return $self;
  55
  56 }
  57
  58 =item serve REQUEST_XML_SCALAR
  59
  60 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').
  61
  62 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.
  63
  64 =cut
  65
  66 sub serve {
  67
  68   my ($self, $request_xml) = (shift, shift);
  69   my $response_xml;
  70
  71   my $coder = $self->{_coder};
  72   my $call = $coder->decode($request_xml);
  73
  74   warn "Got methodCall with method_name='" . $call->{method_name} . "'"
  75     if $DEBUG;
  76
  77   $response_xml = $coder->encode_response(&_serve($call->{method_name}, $call->{value}));
  78
  79   return ('', $response_xml);
  80
  81 }
  82
  83 sub _serve { #Subroutine, not method
  84
  85   my ($method_name, $params) = (shift, shift);
  86
  87   use Data::Dumper;
  88
  89   #die 'Called _serve without parameters' unless ref($params) eq 'ARRAY';
  90   $params = [] unless (ref($params) eq 'ARRAY');
  91
  92   if ($method_name =~ /^(\w+)\.(\w+)/) {
  93
  94     #my ($class, $sub) = split(/\./, $method_name);
  95     my ($class, $sub) = ($1, $2);
  96     my $fssub = "FS::${class}::${sub}";
  97     warn "fssub: ${fssub}" if $DEBUG;
  98     warn "params: " . Dumper($params) if $DEBUG;
  99
 100     my @result;
 101
 102     if ($class eq 'Conf') { #Special case for FS::Conf because we need an obj.
 103
 104       if ($sub eq 'config') {
 105         my $conf = new FS::Conf;
 106         @result = ($conf->config(@$params));
 107       } else {
 108         warn "FS::XMLRPC: Can't call undefined subroutine '${fssub}'";
 109       }
 110
 111     } else {
 112
 113       unless (UNIVERSAL::can("FS::${class}", $sub)) {
 114         warn "FS::XMLRPC: Can't call undefined subroutine '${fssub}'";
 115         # Should we encode an error in the response,
 116         # or just break silently to the remote caller and complain locally?
 117         return [];
 118       }
 119
 120       eval {
 121         no strict 'refs';
 122         my $fssub = "FS::${class}::${sub}";
 123         @result = (&$fssub(@$params));
 124       };
 125
 126       if ($@) {
 127         warn "FS::XMLRPC: Error while calling '${fssub}': $@";
 128         return [];
 129       }
 130
 131     }
 132
 133     warn Dumper(@result);
 134
 135     if (grep { UNIVERSAL::can($_, 'hashref') ? 0 : 1 } @result) {
 136       #warn "FS::XMLRPC: One or more objects returned from '${fssub}' doesn't " .
 137       #     "support the 'hashref' method.";
 138
 139       # If they're not FS::Record decendants, just return the results unmap'd?
 140       # This is more flexible, but possibly more error-prone.
 141       return [ @result ];
 142     } else {
 143       return [ map { $_->hashref } @result ];
 144     }
 145   } elsif ($method_name eq 'version') {
 146     return [ $FS::VERSION ];
 147   } # else...
 148
 149   warn "Unhandle XMLRPC request '${method_name}'";
 150   return [];
 151
 152 }
 153
 154 =head1 BUGS
 155
 156 Probably lots.
 157
 158 =head1 SEE ALSO
 159
 160 L<Frontier::RPC2>.
 161
 162 =cut
 163
 164 1;
 165