fs_selfservice/FS-SelfService/SelfService/XMLRPC.pm

   1 package FS::SelfService::XMLRPC;
   2
   3 =head1 NAME
   4
   5 FS::SelfService::XMLRPC - Freeside XMLRPC accessible self-service API
   6
   7 =head1 SYNOPSIS
   8
   9 =head1 DESCRIPTION
  10
  11 Use this API to implement your own client "self-service" module vi XMLRPC.
  12
  13 Each routine described in L<FS::SelfService> is available vi XMLRPC as the
  14 method FS.SelfService.XMLRPC.B<method>.  All values are passed to the
  15 selfservice-server in a struct of strings.  The return values are in a
  16 struct as strings, arrays, or structs as appropriate for the values
  17 described in L<FS::SelfService>.
  18
  19 =head1 BUGS
  20
  21 =head1 SEE ALSO
  22
  23 L<freeside-selfservice-clientd>, L<freeside-selfservice-server>,L<FS::SelfService>
  24
  25 =cut
  26
  27 use strict;
  28 use vars qw($DEBUG $AUTOLOAD);
  29 use XMLRPC::Lite; # for XMLRPC::Data
  30 use FS::SelfService;
  31
  32 $DEBUG = 0;
  33 $FS::SelfService::DEBUG = $DEBUG;
  34
  35 #false laziness w/FS::ClientAPI_XMLRPC.pm
  36 our %typefix_skin_info = (
  37   'logo'              => 'base64',
  38   'title_left_image'  => 'base64',
  39   'title_right_image' => 'base64',
  40   'menu_top_image'    => 'base64',
  41   'menu_body_image'   => 'base64',
  42   'menu_bottom_image' => 'base64',
  43 );
  44 our %typefix = (
  45   'invoice_pdf'        => { 'invoice_pdf' => 'base64', },
  46   'legacy_invoice_pdf' => { 'invoice_pdf' => 'base64', },
  47   'skin_info'          => \%typefix_skin_info,
  48   'login_info'         => \%typefix_skin_info,
  49   'invoice_logo'       => { 'logo'  => 'base64', },
  50   'login_banner_image' => { 'image' => 'base64', },
  51 );
  52
  53 sub AUTOLOAD {
  54   my $call = $AUTOLOAD;
  55   $call =~ s/^FS::SelfService::XMLRPC:://;
  56
  57   if (exists($FS::SelfService::autoload{$call})) {
  58
  59     shift; #discard package name;
  60
  61     $call = "FS::SelfService::$call";
  62
  63     no strict 'refs';
  64
  65     my $return = &{$call}(@_);
  66
  67     if ( exists($typefix{$call}) ) {
  68       my $typefix = $typefix{$call};
  69       foreach my $field ( grep exists($return->{$_}), keys %$typefix ) {
  70         my $type = $typefix->{$field};
  71         $return->{$field} = XMLRPC::Data->value($return->{$field})
  72                                         ->type($type);
  73       }
  74     }
  75
  76     $return;
  77
  78   }else{
  79     die "No such procedure: $call";
  80   }
  81 }
  82
  83 package SOAP::Transport::HTTP::Daemon;  # yuck
  84
  85 use POSIX qw(:sys_wait_h);
  86
  87 no warnings 'redefine';
  88
  89 sub handle {
  90   my $self = shift->new;
  91
  92   local $SIG{CHLD} = 'IGNORE';
  93
  94 ACCEPT:
  95   while (my $c = $self->accept) {
  96
  97     my $kid = 0;
  98     do {
  99       $kid = waitpid(-1, WNOHANG);
 100       warn "found kid $kid";
 101     } while $kid > 0;
 102
 103     my $pid = fork;
 104     next ACCEPT if $pid;
 105
 106     if ( not defined $pid ) {
 107       warn "fork() failed: $!";
 108       $c = undef;
 109     } else {
 110       while (my $r = $c->get_request) {
 111         $self->request($r);
 112         $self->SUPER::handle;
 113         $c->send_response($self->response);
 114       }
 115       # replaced ->close, thanks to Sean Meisner <Sean.Meisner@VerizonWireless.com>
 116       # shutdown() doesn't work on AIX. close() is used in this case. Thanks to Jos Clijmans <jos.clijmans@recyfin.be>
 117       UNIVERSAL::isa($c, 'shutdown') ? $c->shutdown(2) : $c->close();
 118       $c->close;
 119     }
 120     exit;
 121   }
 122 }
 123
 124 1;