view release on metacpan or  search on metacpan

t/server.t  view on Meta::CPAN

#!/usr/bin/perl -w

use warnings;
use strict;
use lib qw(./t);
use English qw(-no_match_vars);

# Track warnings down during debugging
#use Carp;$SIG{__WARN__} = \&Carp::cluck;

BEGIN
{ 
   # use a BEGIN block to get variables in SOAP::Lite::Constants at compile time
   use Test::More tests => 8;
   use_ok('CAM::SOAPApp', 'lenient' => 1);  # Need lenient to work around warning in SOAP::Lite v0.67
   use_ok('Example::Server');
}

my $PORT = 9670; # an arbitrary choice
my $TIMEOUT = 5; # seconds

if ($OSNAME eq 'darwin' && $ENV{HOST} && $ENV{HOST} eq 'chris.clotho.com')
{
   # Developer workaround for MacOSX issue where port is busy on
   # subsequent runs of this test because the OS holds the listening
   # port open too long.  So, we vary the port number semi-randomly.

   $PORT += (time)%10;
}

SKIP: {

   if (! -f 't/ENABLED')
   {
      skip('User elected to skip tests.',
           # Hack: get the number of tests we expect, skip all but one
           # This hack relies on the soliton nature of Test::Builder
           Test::Builder->new()->expected_tests() - 
           Test::Builder->new()->current_test());
   }

   my $child = fork;
   if ($child)
   {
      # We're the parent, continue below
   }
   elsif (defined $child)
   {
      
      # We're in the child.  Launch the server and continue until parent
      # kills us, or we time out.
      
      $SIG{ALRM} = sub {exit 1};
      alarm $TIMEOUT;
      runServer();
      exit 0;
   }
   else
   {
      die "Fork error...\n";
   }
   
   pass('forked off a server daemon process, waiting 2 seconds');
   
   sleep 2; # wait for server
   
   require IO::Socket;
   my $s = IO::Socket::INET->new(PeerAddr => "localhost:$PORT",
                                 Timeout  => 10);
   ok($s, 'server is running');
   if ($s)
   {
      close $s;
   }

   my $som;
   my $result;
   my $uri = 'http://localhost/Example/Server';
   my $soap = SOAP::Lite->can('ns') ? SOAP::Lite->ns($uri) : SOAP::Lite->uri($uri);
   my $client = $soap
       -> proxy("http://localhost:$PORT/")
       -> on_fault( sub { my ($soap, $fault) = @_;
                          $main::error = ref $fault ? $fault->faultcode() : 'Unknown'; } );