home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / auto / RPC / XML / Server / server_loop.al < prev    next >
Encoding:
Text File  |  2008-11-04  |  2.8 KB  |  99 lines
  1. # NOTE: Derived from blib/lib/RPC/XML/Server.pm.
  2. # Changes made here will be lost when autosplit is run again.
  3. # See AutoSplit.pm.
  4. package RPC::XML::Server;
  5.  
  6. #line 1220 "blib/lib/RPC/XML/Server.pm (autosplit into blib/lib/auto/RPC/XML/Server/server_loop.al)"
  7. sub server_loop
  8. {
  9.     my $self = shift;
  10.  
  11.     if ($self->{__daemon})
  12.     {
  13.         my ($conn, $req, $resp, $reqxml, $return, $respxml, $exit_now,
  14.             $timeout);
  15.  
  16.         my %args = @_;
  17.  
  18.         # Localize and set the signal handler as an exit route
  19.         my @exit_signals;
  20.  
  21.         if (exists $args{signal} and $args{signal} ne 'NONE')
  22.         {
  23.             @exit_signals =
  24.                 (ref $args{signal}) ? @{$args{signal}} : $args{signal};
  25.         }
  26.         else
  27.         {
  28.             push @exit_signals, 'INT';
  29.         }
  30.  
  31.         local @SIG{@exit_signals} = ( sub { $exit_now++ } ) x @exit_signals;
  32.  
  33.         $self->started('set');
  34.         $exit_now = 0;
  35.         $timeout = $self->{__daemon}->timeout(1);
  36.         while (! $exit_now)
  37.         {
  38.             $conn = $self->{__daemon}->accept;
  39.  
  40.             last if $exit_now;
  41.             next unless $conn;
  42.             $conn->timeout($self->timeout);
  43.             $self->process_request($conn);
  44.             $conn->close;
  45.             undef $conn; # Free up any lingering resources
  46.         }
  47.  
  48.         $self->{__daemon}->timeout($timeout) if defined $timeout;
  49.     }
  50.     else
  51.     {
  52.         # This is the Net::Server block, but for now HTTP::Daemon is needed
  53.         # for the code that converts socket data to a HTTP::Request object
  54.         require HTTP::Daemon;
  55.  
  56.         my $conf_file_flag = 0;
  57.         my $port_flag = 0;
  58.         my $host_flag = 0;
  59.  
  60.         for (my $i = 0; $i < @_; $i += 2)
  61.         {
  62.             $conf_file_flag = 1 if ($_[$i] eq 'conf_file');
  63.             $port_flag = 1 if ($_[$i] eq 'port');
  64.             $host_flag = 1 if ($_[$i] eq 'host');
  65.         }
  66.  
  67.         # An explicitly-given conf-file trumps any specified at creation
  68.         if (exists($self->{conf_file}) and (! $conf_file_flag))
  69.         {
  70.             push (@_, 'conf_file', $self->{conf_file});
  71.             $conf_file_flag = 1;
  72.         }
  73.  
  74.         # Don't do this next part if they've already given a port, or are
  75.         # pointing to a config file:
  76.         unless ($conf_file_flag or $port_flag)
  77.         {
  78.             push (@_, 'port', $self->{port} || $self->port || 9000);
  79.             push (@_, 'host', $self->{host} || $self->host || '*');
  80.         }
  81.  
  82.         # Try to load the Net::Server::MultiType module
  83.         eval { require Net::Server::MultiType; };
  84.         return ref($self) .
  85.             "::server_loop: Error loading Net::Server::MultiType: $@"
  86.                 if ($@);
  87.         unshift(@RPC::XML::Server::ISA, 'Net::Server::MultiType');
  88.  
  89.         $self->started('set');
  90.         # ...and we're off!
  91.         $self->run(@_);
  92.     }
  93.  
  94.     return;
  95. }
  96.  
  97. # end of RPC::XML::Server::server_loop
  98. 1;
  99.