diff options
Diffstat (limited to 'tests/LightyTest.pm')
-rw-r--r--[-rwxr-xr-x] | tests/LightyTest.pm | 79 |
1 files changed, 58 insertions, 21 deletions
diff --git a/tests/LightyTest.pm b/tests/LightyTest.pm index 36029dc8..da65bec7 100755..100644 --- a/tests/LightyTest.pm +++ b/tests/LightyTest.pm @@ -1,6 +1,5 @@ -#! /usr/bin/perl -w - package LightyTest; + use strict; use IO::Socket; use Test::More; @@ -9,11 +8,46 @@ use Cwd 'abs_path'; use POSIX qw(:sys_wait_h dup2); use Errno qw(EADDRINUSE); +sub find_program { + my @DEFAULT_PATHS = ('/usr/bin/', '/usr/local/bin/'); + my ($envname, $program) = @_; + my $location; + + if (defined $ENV{$envname}) { + $location = $ENV{$envname}; + } else { + $location = `which "$program" 2>/dev/null`; + if (! -x $location) { + for my $path (@DEFAULT_PATHS) { + $location = $path . $program; + last if -x $location; + } + } + } + + if (-x $location) { + $ENV{$envname} = $location; + return 1; + } else { + delete $ENV{$envname}; + return 0; + } +} + +BEGIN { + our $HAVE_PHP = find_program('PHP', 'php-cgi'); + our $HAVE_PERL = find_program('PERL', 'perl'); + if (!$HAVE_PERL) { + die "Couldn't find path to perl, but it obviously seems to be running"; + } +} + sub mtime { my $file = shift; my @stat = stat $file; return @stat ? $stat[9] : 0; } + sub new { my $class = shift; my $self = {}; @@ -58,10 +92,10 @@ sub listening_on { my $self = shift; my $port = shift; - my $remote = - IO::Socket::INET->new(Proto => "tcp", - PeerAddr => "127.0.0.1", - PeerPort => $port) or return 0; + my $remote = IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => "127.0.0.1", + PeerPort => $port) or return 0; close $remote; @@ -165,14 +199,15 @@ sub handle_http { my $slow = defined $t->{SLOWREQUEST}; my $is_debug = $ENV{"TRACE_HTTP"}; - my $remote = - IO::Socket::INET->new(Proto => "tcp", - PeerAddr => $host, - PeerPort => $self->{PORT}); + my $remote = + IO::Socket::INET->new( + Proto => "tcp", + PeerAddr => $host, + PeerPort => $self->{PORT}); if (not defined $remote) { diag("\nconnect failed: $!"); - return -1; + return -1; } $remote->autoflush(1); @@ -208,7 +243,7 @@ sub handle_http { print $remote "\012"; select(undef, undef, undef, 0.1); } - + } diag("\n... done") if $is_debug; @@ -221,7 +256,7 @@ sub handle_http { diag(">> ".$_) if $is_debug; } diag("\n... done") if $is_debug; - + close $remote; my $full_response = $lines; @@ -250,8 +285,8 @@ sub handle_http { (my $h = $1) =~ tr/[A-Z]/[a-z]/; if (defined $resp_hdr{$h}) { -# diag(sprintf("\nheader '%s' is duplicated: '%s' and '%s'\n", -# $h, $resp_hdr{$h}, $2)); +# diag(sprintf("\nheader '%s' is duplicated: '%s' and '%s'\n", +# $h, $resp_hdr{$h}, $2)); $resp_hdr{$h} .= ', '.$2; } else { $resp_hdr{$h} = $2; @@ -307,7 +342,7 @@ sub handle_http { return -1; } } - + if (defined $href->{'-HTTP-Content'}) { if (defined $resp_body && $resp_body ne '') { diag(sprintf("\nbody failed: expected empty body, got '%s'", $resp_body)); @@ -334,7 +369,7 @@ sub handle_http { $k = substr($k, 1); $key_inverted = 1; $verify_value = 0; ## skip the value check - } + } if ($key_inverted) { if (defined $resp_hdr{$k}) { @@ -351,13 +386,15 @@ sub handle_http { if ($verify_value) { if ($href->{$_} =~ /^\/(.+)\/$/) { if ($resp_hdr{$k} !~ /$1/) { - diag(sprintf("\nresponse-header failed: expected '%s', got '%s', regex: %s", - $href->{$_}, $resp_hdr{$k}, $1)); + diag(sprintf( + "\nresponse-header failed: expected '%s', got '%s', regex: %s", + $href->{$_}, $resp_hdr{$k}, $1)); return -1; } } elsif ($href->{$_} ne $resp_hdr{$k}) { - diag(sprintf("\nresponse-header failed: expected '%s', got '%s'", - $href->{$_}, $resp_hdr{$k})); + diag(sprintf( + "\nresponse-header failed: expected '%s', got '%s'", + $href->{$_}, $resp_hdr{$k})); return -1; } } |