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