source: gs2-extensions/parallel-building/trunk/src/bin/script/test-server.pl@ 30354

#!/usr/bin/perl

use strict;
use warnings;

BEGIN
{
  die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
  die "GSDLOS not set\n" unless defined $ENV{'GSDLOS'};

  unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
  unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan");
  unshift (@INC, "$ENV{'GSDLHOME'}/perllib/cpan/XML/XPath");
  unshift (@INC, "$ENV{'GSDLHOME'}/perllib/plugins");
  unshift (@INC, "$ENV{'GSDLHOME'}/perllib/classify");

  if (defined $ENV{'GSDLEXTS'})
  {
    my @extensions = split(/:/,$ENV{'GSDLEXTS'});
    foreach my $e (@extensions)
    {
      my $ext_prefix = "$ENV{'GSDLHOME'}/ext/$e";
      unshift (@INC, "$ext_prefix/perllib");
      unshift (@INC, "$ext_prefix/perllib/cpan");
      unshift (@INC, "$ext_prefix/perllib/plugins");
      unshift (@INC, "$ext_prefix/perllib/classify");
    }
  }
  if (defined $ENV{'GSDL3EXTS'})
  {
    my @extensions = split(/:/,$ENV{'GSDL3EXTS'});
    foreach my $e (@extensions)
    {
      my $ext_prefix = "$ENV{'GSDL3SRCHOME'}/ext/$e";
      unshift (@INC, "$ext_prefix/perllib");
      unshift (@INC, "$ext_prefix/perllib/cpan");
      unshift (@INC, "$ext_prefix/perllib/plugins");
      unshift (@INC, "$ext_prefix/perllib/classify");
    }
  }

  # Manually installed CPAN package in GEXT*INSTALL
  unshift (@INC, $ENV{'GEXTPARALLELBUILDING_INSTALLED'} . "/share/perl5");
}

use SocketsSwimmingThreadPoolClient;
use SocketsSwimmingThreadPoolServer;

# Configuration
my $host = 'localhost';
my $port = 8190;

# Fork ourselves
my $child_pid = fork();
# Ensure fork() worked
if (!defined($child_pid))
{
  die("Fatal Error! Fork didn't.");
}
# Parent process creates the server socket and sits there listening
if ($child_pid > 0)
{
  my $server = SocketsSwimmingThreadPoolServer->new(host=>$host,
                                                    port=>$port,
                                                    processor_cb => \&serverProcess
                                                   );
  print STDERR "[Server] Listening\n";
  $server->start;
  print STDERR "[Server] Shutdown\n";
}
# Child socket spawns 100,000 client connections one after the other
else
{
  for (my $i = 0; $i < 100000; $i++)
  {
    sendMessage('msg' . $i);
  }
  # Ask the server to shutdown
  sendMessage('quit');
}

exit(0);

sub sendMessage
{
  my ($message) = @_;
  my $client = SocketsSwimmingThreadPoolClient->new(host=>$host,
                                                    port=>$port
                                                   );
  my $result = $client->query($message);
  print "[Client] Response: $result\n";
}

# All the server does is echo the reverse of the request
sub serverProcess
{
  my ($data, $ip, $tid, $fnstop) = @_;
  print "[Server] Request: $data\n";
  my $value = reverse $data;
  if ($data =~ /quit/)
  {
    $fnstop->();
    $value = 'Quitting!';
  }
  return $value;
}

1;