if ($^O eq "MacOS") {
    print "1..0\n";
    exit(0);
}

$| = 1; # autoflush

$DEBUG = 0;
$NONBLOCK = 0; # set to 1 to try out non-blocking connects (new in 2.51)
#use LWP::Debug qw(+debug +trace +conns);


# uncomment the following line if you want to run these tests from the command
# line using the local version of Parallel::UserAgent (otherwise perl will take
# the already installed version):
# use lib ('./lib');

# First we create HTTP server for testing our http protocol
# (this is stolen from the LWP t/local/http.t file)

require IO::Socket;  # make sure this work before we try to make a HTTP::Daemon

# First we make ourself a daemon in another process
my $D = shift || '';
if ($D eq 'daemon') {

    require HTTP::Daemon;

    my $d = new HTTP::Daemon Timeout => 10;

    print "Please to meet you at: <URL:", $d->url, ">\n";
    open(STDOUT, ">/dev/null");

    while ($c = $d->accept) {
	$r = $c->get_request;
	if ($r) {
	    my $p = ($r->url->path_segments)[1];
	    my $func = lc("httpd_" . $r->method . "_$p");
	    if (defined &$func) {
		&$func($c, $r);
	    } else {
		$c->send_error(404);
	    }
	}
	$c = undef;  # close connection
    }
    print STDERR "HTTP Server terminated\n" if $DEBUG;
} else {
    use Config;
    open(DAEMON, "$Config{'perlpath'} local/http.t daemon |") or die "Can't exec daemon: $!";
}

package myPUA;
use LWP::Parallel::UserAgent qw(:CALLBACK);
@ISA = qw(LWP::Parallel::UserAgent);

# redefine methods: on_connect gets called whenever we are about to
# make a a connection

$myPUA::order_history = [];
sub on_connect {
    my ($self, $request, $response, $entry) = @_;
    my $url = $request->url->as_string;
    $url =~ s/^.*\?//;
    push @{$myPUA::order_history}, $url;
}

sub order_history {
  my $history = shift if $_;
  return $myPUA::order_history unless $history;
  $myPUA::order_history = $history;
}

package main;

print "1..15\n";

my $greeting = <DAEMON>;
$greeting =~ /(<[^>]+>)/;

require URI;
my $base = URI->new($1);
sub url {
   my $u = URI->new(@_);
   $u = $u->abs($_[1]) if @_ > 1;
   $u->as_string;
}

# find additional, locally installed web server for testing
##$uat = new LWP::UserAgent; 
##$res = $uat->head("http://localhost:80"); 
##print "not " if $res->code == 500; print "ok: ". $res->code . "\n"; 

print "Will access HTTP server at $base\n";

# do tests from here on

#use LWP::Debug qw(+);

require LWP::Parallel::UserAgent;
require HTTP::Request;
my $ua = new LWP::Parallel::UserAgent;
$ua->agent("Mozilla/0.01 " . $ua->agent);
$ua->from('marclang@cpan.org');
$ua->nonblock($NONBLOCK);  


#---------------------------------------------------------------
print "\nLWP::Parallel::UserAgent interface...";
print "\nSingle bad request..\n";
$req = new HTTP::Request GET => url("/not_found", $base);
$req->header(X_Foo => "Bar");

print STDERR "\tRegistering '".$req->url."'\n" if $::DEBUG;
if ( $res = $ua->register ($req) ) { 
    print STDERR $res->error_as_HTML;
    print "not";
} 
print "ok 1\n";

my $entries = $ua->wait(5);
foreach (keys %$entries) {
    # each entry available under the url-string of their request contains
    # a number of fields. The most important are $entry->request and
    # $entry->response. 
    $res = $entries->{$_}->response;
    print STDERR "Answer for '",$res->request->url, "' was \t", 
          $res->code,": ", $res->message,"\n" if $DEBUG;

    print "not " unless $res->is_error
                        and $res->code == 404
                        and $res->message =~ /not\s+found/i;

    print "ok 2\n";
    print "not " if !$res->server and !$res->date;
    print "ok 3\n";
}

#----------------------------------------------------------------
print "\nMultiple Requests...\n";
sub httpd_get_page0
{
    my($c) = @_;
    $c->send_basic_header(200);
    print $c "Content-Type: text/plain\015\012";
    $c->send_crlf;
    print $c "This is page 0";
}

sub httpd_get_page1
{
    my($c) = @_;
    $c->send_basic_header(200);
    print $c "Content-Type: text/plain\015\012";
    $c->send_crlf;
    print $c "This is page 1";
}

sub httpd_get_page2
{
    my($c) = @_;
    $c->send_basic_header(200);
    print $c "Content-Type: text/plain\015\012";
    $c->send_crlf;
    print $c "This is page 2";
}

$ua->initialize;
for $i (0..11) {
    my $page = $i % 3;
    $req = new HTTP::Request GET => url("/page$page", $base);
    print STDERR "\tRegistering '".$req->url."'\n" if $DEBUG;
    if ( $res = $ua->register ($req) ) { 
	print STDERR $res->error_as_HTML;
	print "not";
	last;
    } 
}
print "ok 4\n";

$entries = $ua->wait(5);
foreach (keys %$entries) {
    $res = $entries->{$_}->response;
    my $url = $res->request->url;
    $url =~ /([0-9]+)$/;
    my $num = $1;

    print STDERR "Answer for '$url' was \n\t", 
          $res->code,": ", $res->message," \"", $res->content, "\"\n"
	      if $DEBUG;

    unless ( $res->content =~ /This is page $num/ ) {
	print "not ";
	last;
    }
}
print "ok 5\n";

#----------------------------------------------------------------
print "\nLarger number of requests (40)..\n";

$ua->initialize;

for $i (0..40) {
    my $page = $i % 3;
    $req = new HTTP::Request GET => url("/page$page", $base);
    print STDERR "\tRegistering '".$req->url."'\n" if $DEBUG;
    if ( $res = $ua->register ($req) ) { 
	print STDERR $res->error_as_HTML;
	print "not";
	last;
    } 
}
print "ok 6\n";
$i=0;
$entries = $ua->wait(5);
foreach (keys %$entries) {
    $res = $entries->{$_}->response;
    my $url = $res->request->url;
    $url =~ /([0-9]+)$/;
    my $num = $1;

    print STDERR "Answer for '$url' was \n\t", 
          $res->code,": ", $res->message," \"", $res->content, "\"\n"
	      if $DEBUG;
    unless ($res->content =~ /This is page $num/) 
    {
	print STDERR "Oops: Answer ($i) for '$url' was \n\t", 
	$res->code,": ", $res->message," \"", $res->content, "\"\n";
	          
	print ("not ");
	last;
    }
    $i++;
}
print "ok 7\n";

#----------------------------------------------------------------
sub httpd_get_echo
{
    my($c, $req) = @_;
    $c->send_basic_header(200);
    print $c "Content-Type: text/plain\015\012";
    $c->send_crlf;
    print $c $req->as_string;
}

sub httpd_get_redirect
{
   my($c) = @_;
   $c->send_redirect("/echo/redirect");
}

print "\nCheck redirect on/off...\n";

$ua->initialize;
$ua->redirect(1);

$req = new HTTP::Request GET => url("/redirect/foo", $base);
print STDERR "\tRegistering '".$req->url."'\n" if $DEBUG;
if ( $res = $ua->register ($req) ) { 
    print STDERR $res->error_as_HTML;
    print "not ok 8\nnot ok 9\n";
} else {
    $entries = $ua->wait(5);
    foreach (keys %$entries) {
	$res = $entries->{$_}->response;
	print "not " unless $res->is_success
	    and $res->content =~ m|/echo/redirect|;
	print "ok 8\n";
	print "not " unless $res->previous 
                        and $res->previous->is_redirect
          	        and $res->previous->code == 301;
	print "ok 9\n";
	last;
    }
}

$ua->initialize;
$ua->redirect(0);

print STDERR "\tRegistering '".$req->url."'\n" if $DEBUG;
if ( $res = $ua->register ($req) ) { 
    print STDERR $res->error_as_HTML;
    print "not ok 10\nnot ok 11\n";
} else {
    $entries = $ua->wait(5);
    foreach (keys %$entries) {
	$res = $entries->{$_}->response;
	print "not " if $res->is_success
	    and $res->content =~ m|/echo/redirect|;
	print "ok 10\n";
	print "not " unless $res->code == 301;
	print "ok 11\n";
	last;
    }
}

#----------------------------------------------------------------
print "\nTesting ordered connections...\n";

my @req_history = ();
sub httpd_get_num
{
    my($c, $req) = @_;
    my $num = $req->url->as_string;
    $num =~ s/^.*\?//;
    push @req_history, $num;
    my $msg = "Request History: ". join (", ", @req_history) . "\n"; 

#    sleep (int(rand(3))); # sleep some

    $c->send_basic_header(200);
    print $c "Content-Type: text/plain\015\012";
    $c->send_crlf;
    print $c $msg;
}

my $uao = new myPUA { 'handle_in_order' => 0 };

for (0..40) {
  $req = new HTTP::Request GET => url("/num?$_", $base);
  print STDERR "\tRegistering '".$req->url."'\n" if $DEBUG;
  if ( $res = $uao->register ($req) ) { 
    print STDERR $res->error_as_HTML;
    print "not";
  } 
}
print "ok 12\n";

$entries = $uao->wait(5);

my @history = @{$uao->order_history()};
for (0..40) {
  print "not" unless $history[$_] == $_;
}

print "ok 13\n";

#----------------------------------------------------------------
print "\nTerminating server...\n";
sub httpd_get_quit
{
    my($c) = @_;
    $c->send_error(503, "Bye, bye");
    exit;  # terminate HTTP server
}
$ua->initialize;
$req = new HTTP::Request GET => url("/quit", $base);
print STDERR "\tRegistering '".$req->url."'\n" if $DEBUG;
if ( $res = $ua->register ($req) ) { 
    print STDERR $res->error_as_HTML;
    print "not";
} 
print "ok 14\n";

$entries = $ua->wait(5);
foreach (keys %$entries) {
    # each entry available under the url-string of their request contains
    # a number of fields. The most important are $entry->request and
    # $entry->response. 
    $res = $entries->{$_}->response;
    print STDERR "Answer for '",$res->request->url, "' was \t", 
          $res->code,": ", $res->message,"\n" if $DEBUG;

    print "not " unless $res->code == 503 and $res->content =~ /Bye, bye/;
    print "ok 15\n";
}