use strict;
use warnings;

use Data::Dumper;
use CGI::Carp qw/fatalsToBrowser/;
use CGI;

my $cgi = new CGI;

unless ($cgi->param()) {
   print "Content-type: text/html\n\n";
   print "<form action=$ENV{'SCRIPT_NAME'}><input type=text name=test><input type=submit></form>";
}

else {

   my $param = $cgi->param('test');
   my @patterns = find_patterns($param);   
   print Dumper( lookup(@patterns) );
}

#----------------------------------

sub lookup(@) {

BEGIN { unshift @INC, "/home/test/lib" }

use XML_Client qw(:default);
use Data::Dumper;

   $SIG{CHLD} = \&sig_chld;

   my @search = @_;

   my %return;
   my @spawn;
   my $XML_Client = new XML_Client();
   $XML_Client->login;

   use IO::Handle;
   pipe(READER, WRITER);
   #WRITER->autoflush(1);
   for (0..$#search) {
      my $pid = &child($search[$_], $XML_Client);
      push @spawn, $pid;
   }
   close WRITER;

   local $SIG{ALRM} = sub { die "timeout\n" };
   alarm 20;
   waitpid($spawn[-1],0);
   for (0..$#search-1) {
      my $feedback = <READER>;
      chomp $feedback;
      $return{$_} = $feedback;
   }
   alarm 0;

   return %return;

END { $XML_Client->logout if $XML_Client }

#-------------------------------

sub child($$) {
   my $search = shift;
   my $XML_Client = shift;

   my $return;
   unless (my $pid = fork) {
      close READER;
      local $SIG{ALRM} = sub { die "child timeout\n" };

      my $lookup_data = {
                     action => "lookup",
                     attributes => {
                        search => $search,
                     }
             };
      my $lookup_results;
      eval {
            local $SIG{ALRM} = sub { die "child timeout\n" };
            alarm 15;
            $lookup_results = $XML_Client->send_cmd( $lookup_data ) or warn PROG $!;
            alarm 0;
         };
         if ($@) {
            #timed out
            die unless $@ eq "child timeout\n";
         }
	 else {
               print WRITER $lookup_results->{status} . "\n";
		exit 1;
         }
    return $pid;
  }

#-----------------------------------

sub sig_chld {
   use POSIX ":sys_wait_h";
   my $child = waitpid(-1, WNOHANG);
   $SIG{CHLD} = \&sig_chld;
}