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 FS::SelfService;
  30
  31 $DEBUG = 0;
  32 $FS::SelfService::DEBUG = $DEBUG;
  33
  34 sub AUTOLOAD {
  35   my $call = $AUTOLOAD;
  36   $call =~ s/^FS::SelfService::XMLRPC:://;
  37   if (exists($FS::SelfService::autoload{$call})) {
  38     shift; #discard package name;
  39     $call = "FS::SelfService::$call";
  40     no strict 'refs';
  41     &{$call}(@_);
  42   }else{
  43     die "No such procedure: $call";
  44   }
  45 }
  46
  47 package SOAP::Transport::HTTP::Daemon;  # yuck
  48
  49 use POSIX qw(:sys_wait_h);
  50
  51 no warnings 'redefine';
  52
  53 sub handle {
  54   my $self = shift->new;
  55
  56   local $SIG{CHLD} = 'IGNORE';
  57
  58 ACCEPT:
  59   while (my $c = $self->accept) {
  60
  61     my $kid = 0;
  62     do {
  63       $kid = waitpid(-1, WNOHANG);
  64       warn "found kid $kid";
  65     } while $kid > 0;
  66
  67     my $pid = fork;
  68     next ACCEPT if $pid;
  69
  70     if ( not defined $pid ) {
  71       warn "fork() failed: $!";
  72       $c = undef;
  73     } else {
  74       while (my $r = $c->get_request) {
  75         $self->request($r);
  76         $self->SUPER::handle;
  77         $c->send_response($self->response);
  78       }
  79       # replaced ->close, thanks to Sean Meisner <Sean.Meisner@VerizonWireless.com>
  80       # shutdown() doesn't work on AIX. close() is used in this case. Thanks to Jos Clijmans <jos.clijmans@recyfin.be>
  81       UNIVERSAL::isa($c, 'shutdown') ? $c->shutdown(2) : $c->close();
  82       $c->close;
  83     }
  84     exit;
  85   }
  86 }
  87
  88 1;