use Cwd; use Config; $cur_dir = cwd(); $failed = 0; die "Must be in build directory\n" unless -d 'blib'; die "No tests defined for Windows\n" if $^O =~ /win32/i; $ENV{MINIVEND_ROOT} = "$cur_dir/blib"; $ENV{MINIVEND_PORT} = 8786 unless defined $ENV{MINIVEND_PORT}; open(CONFIG, ">$ENV{MINIVEND_ROOT}/minivend.cfg") or die "open: $!\n"; print CONFIG <$ENV{MINIVEND_ROOT}/catalog.cfg") or die "open: $!\n"; print CONFIG <$ENV{MINIVEND_ROOT}/products/products.asc") or die "open: $!\n"; print CONFIG <$ENV{MINIVEND_ROOT}/pages/catalog.html") or die "open: $!\n"; for(1 .. 100) { print CONFIG <; $pid =~ s/\D+//g; last; } for(1 .. 5) { unless (-e "$ENV{MINIVEND_ROOT}/etc/socket") { system "ls -l $ENV{MINIVEND_ROOT}/*"; sleep $_; next; } $LINK_FILE = "$ENV{MINIVEND_ROOT}/etc/socket"; last; } if(! $pid or ! $LINK_FILE) { print "not ok $testnum\n"; $failed++; } else { print "ok $testnum\n"; } $testnum++; use Socket; my $LINK_HOST = 'localhost'; my $LINK_PORT = $ENV{MINIVEND_PORT}; my $LINK_TIMEOUT = 15; my $ERROR_ACTION = "-none"; $ENV{SCRIPT_NAME} = "/test"; $ENV{PATH_INFO} = "/catalog"; $ENV{REMOTE_ADDR} = "TEST"; $ENV{REQUEST_METHOD} = "GET"; sub send_arguments { my $count = @ARGV; my $val = "arg $count\n"; for(@ARGV) { $val .= length($_); $val .= " $_\n"; } return $val; } sub send_environment () { my (@tmp) = keys %ENV; my $count = @tmp; my ($str); my $val = "env $count\n"; for(@tmp) { $str = "$_=$ENV{$_}"; $val .= length($str); $val .= " $str\n"; } return $val; } $SIG{PIPE} = sub { die("signal"); }; $SIG{ALRM} = sub { die("not communicating with server\n"); exit 1; }; print "link/unixmode........."; eval { socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!\n"; my $ok; do { $ok = connect(SOCK, sockaddr_un($LINK_FILE)); } while ( ! defined $ok and $! =~ /interrupt|such file or dir/i); my $undef = ! defined $ok; die "ok=$ok def: $undef connect: $!\n" if ! $ok; select SOCK; $| = 1; select STDOUT; print SOCK send_arguments(); print SOCK send_environment(); print SOCK "end\n"; while() { $result .= $_; } close (SOCK) or die "close: $!\n"; }; if(length($result) > 500 and $result =~ /test succeeded/i) { print "ok $testnum\n"; } else { print "not ok $testnum"; print " ($@)" if $@; print "\n"; $failed++; } $testnum++; print "server/inetmode......."; if ( system qq{$Config{'perlpath'} blib/script/minivend -q -r -i} ) { print "not ok $testnum\n"; $failed++; } else { print "ok $testnum\n"; } $testnum++; alarm 0; alarm $LINK_TIMEOUT; $result = ''; print "link/inetmode........."; eval { $remote = $LINK_HOST; $port = $LINK_PORT; if ($port =~ /\D/) { $port = getservbyname($port, 'tcp'); } die("no port") unless $port; $iaddr = inet_aton($remote); $paddr = sockaddr_in($port,$iaddr); $proto = getprotobyname('tcp'); socket(SOCK, PF_INET, SOCK_STREAM, $proto) or die "socket: $!\n"; my $ok; do { $ok = connect(SOCK, $paddr); } while ( ! defined $ok and $! =~ /interrupt/i); my $undef = ! defined $ok; die "ok=$ok def: $undef connect: $!\n" if ! $ok; select SOCK; $| = 1; select STDOUT; print SOCK send_arguments(); print SOCK send_environment(); print SOCK "end\n"; while() { $result .= $_; } close (SOCK) or die "close: $!\n"; }; if(length($result) > 500 and $result =~ /test succeeded/i) { print "ok $testnum\n"; } else { print "not ok $testnum\n"; $failed++; } $testnum++; print "server/control........"; if ( system qq{$Config{'perlpath'} blib/script/minivend -q -stop} ) { print "not ok $testnum\n"; $failed++; } my $pid_there; for(1 .. 5) { $pid_there = -f 'blib/etc/minivend.pid'; last unless $pid_there; sleep 1; } if ($pid_there) { print "not ok $testnum\n"; $failed++; } else { print "ok $testnum\n"; } $testnum++; $testnum--; print "$testnum tests run"; if($failed) { print " -- $failed/$testnum failed.\n"; exit 1; } else { print ", all tests successful.\n"; exit 0; } END { kill 'KILL', $pid if $pid; }