view release on metacpan or  search on metacpan

t/server.t  view on Meta::CPAN

#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'; } );

   my $prefix = $SOAP::Constants::PREFIX_ENV || 'SOAP-ENV';
   call($client, 'isLeapYear', [             ], [0, $prefix.':NoYear'], 'Fault: NoYear');
   call($client, 'isLeapYear', [year => 'doh'], [0, $prefix.':BadYear'],'Fault: BadYear');
   call($client, 'isLeapYear', [year => 1996 ], [1, 1], '1996 is a leap year');
   call($client, 'isLeapYear', [year => 2003 ], [1, 0], '2003 is not a leap year');

   # Stop the server
   $client->call('quit');
   kill 9, $child; # just in case
}

exit 0;

sub call
{
   my $client = shift;
   my $method = shift;
   my $args = shift;
   my $expect = shift;
   my $desc = shift;

   my @args = ();
   for (my $i=0; $i<@{$args}; $i+=2)
   {
      my $key = $args->[$i];
      my $val = $args->[$i+1];
      push @args, SOAP::Data->name($key, $val);
   }
   
   $main::error = q{};
   my $som = $client->call($method, @args);
   if ($expect->[0])
   {
      if (ref $som)
      {
         is($som->result(), $expect->[1], $desc);
      }
      else
      {
         fail($desc);
      }
   }
   else
   {
      if (ref $som)