Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

302 lines (234 sloc) 5.329 kb
use Cwd;
use Config;
use Errno;
$cur_dir = cwd();
$failed = 0;
if($^O =~ /cygwin|win32/) {
print "no tests supported on Windows platform.\n";
exit;
}
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}/interchange.cfg")
or die "open: $!\n";
print CONFIG <<EOF;
Catalog test $ENV{MINIVEND_ROOT} /test
TcpMap $ENV{MINIVEND_PORT} -
TagDir 0
TagDir etc
EOF
open(CONFIG, ">$ENV{MINIVEND_ROOT}/catalog.cfg")
or die "open: $!\n";
print CONFIG <<'EOF';
MailOrderTo info@icdevgroup.org
VendURL http:/test
SecureURL http:/test
Database products products.asc DEFAULT
EOF
mkdir ("$ENV{MINIVEND_ROOT}/etc", 0777);
mkdir ("$ENV{MINIVEND_ROOT}/pages", 0777);
mkdir ("$ENV{MINIVEND_ROOT}/products", 0777);
mkdir ("$ENV{MINIVEND_ROOT}/session", 0777);
if( $ENV{PERL5LIB} ) {
$ENV{PERL5LIB} .= ":$cur_dir/extra:$cur_dir/blib/lib";
}
else {
$ENV{PERL5LIB} = "$cur_dir/extra:$cur_dir/blib/lib";
}
my $testnum = 1;
open(CONFIG, ">$ENV{MINIVEND_ROOT}/products/products.asc")
or die "open: $!\n";
print CONFIG <<EOF;
sku description price
test test product 1
EOF
open(CONFIG, ">$ENV{MINIVEND_ROOT}/pages/catalog.html")
or die "open: $!\n";
for(1 .. 100) {
print CONFIG <<EOF;
test succeeded test succeeded
EOF
}
close CONFIG;
$| = 1;
print "server/unixmode.......";
if ( system qq{$Config{'perlpath'} blib/script/interchange -q -r -u} ) {
print "not ok $testnum\n";
$failed++;
}
else {
print "ok $testnum\n";
}
$testnum++;
print "server/startup........";
for(1 .. 5) {
open(PID, "$ENV{MINIVEND_ROOT}/etc/interchange.pid") or sleep $_, next;
$pid = <PID>;
$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 = '127.0.0.1';
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 $!{EINTR} || $!{ENOENT});
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(<SOCK>) {
$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";
print <<EOF;
# When the above test fails, it may be due to your ISP or some other
# mechanism blocking port 8786.
EOF
$failed++;
}
$testnum++;
print "server/inetmode.......";
if ( system qq{$Config{'perlpath'} blib/script/interchange -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 $!{EINTR});
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(<SOCK>) {
$result .= $_;
}
close (SOCK) or die "close: $!\n";
};
alarm 0;
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/interchange -q -stop} ) {
print "not ok $testnum\n";
$failed++;
}
my $pid_there;
for(1 .. 5) {
$pid_there = -f 'blib/etc/interchange.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;
}
Jump to Line
Something went wrong with that request. Please try again.