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