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 = (
  37   'invoice_pdf'        => { 'invoice_pdf' => 'base64', },
  38   'legacy_invoice_pdf' => { 'invoice_pdf' => 'base64', },
  39   'skin_info'          => { 'logo'              => 'base64',
  40                             'title_left_image'  => 'base64',
  41                             'title_right_image' => 'base64',
  42                             'menu_top_image'    => 'base64',
  43                             'menu_body_image'   => 'base64',
  44                             'menu_bottom_image' => 'base64',
  45                           },
  46   'invoice_logo'       => { 'logo' => 'base64', },
  47 );
  48
  49 sub AUTOLOAD {
  50   my $call = $AUTOLOAD;
  51   $call =~ s/^FS::SelfService::XMLRPC:://;
  52
  53   if (exists($FS::SelfService::autoload{$call})) {
  54
  55     shift; #discard package name;
  56
  57     $call = "FS::SelfService::$call";
  58
  59     no strict 'refs';
  60
  61     my $return = &{$call}(@_);
  62
  63     if ( exists($typefix{$call}) ) {
  64       my $typefix = $typefix{$call};
  65       foreach my $field ( grep exists($return->{$_}), keys %$typefix ) {
  66         my $type = $typefix->{$field};
  67         $return->{$field} = XMLRPC::Data->value($return->{$field})
  68                                         ->type($type);
  69       }
  70     }
  71
  72     $return;
  73
  74   }else{
  75     die "No such procedure: $call";
  76   }
  77 }
  78
  79 package SOAP::Transport::HTTP::Daemon;  # yuck
  80
  81 use POSIX qw(:sys_wait_h);
  82
  83 no warnings 'redefine';
  84
  85 sub handle {
  86   my $self = shift->new;
  87
  88   local $SIG{CHLD} = 'IGNORE';
  89
  90 ACCEPT:
  91   while (my $c = $self->accept) {
  92
  93     my $kid = 0;
  94     do {
  95       $kid = waitpid(-1, WNOHANG);
  96       warn "found kid $kid";
  97     } while $kid > 0;
  98
  99     my $pid = fork;
 100     next ACCEPT if $pid;
 101
 102     if ( not defined $pid ) {
 103       warn "fork() failed: $!";
 104       $c = undef;
 105     } else {
 106       while (my $r = $c->get_request) {
 107         $self->request($r);
 108         $self->SUPER::handle;
 109         $c->send_response($self->response);
 110       }
 111       # replaced ->close, thanks to Sean Meisner <Sean.Meisner@VerizonWireless.com>
 112       # shutdown() doesn't work on AIX. close() is used in this case. Thanks to Jos Clijmans <jos.clijmans@recyfin.be>
 113       UNIVERSAL::isa($c, 'shutdown') ? $c->shutdown(2) : $c->close();
 114       $c->close;
 115     }
 116     exit;
 117   }
 118 }
 119
 120 1;