diff options
Diffstat (limited to 't/robot/ua.t')
| -rw-r--r-- | t/robot/ua.t | 151 |
1 files changed, 151 insertions, 0 deletions
diff --git a/t/robot/ua.t b/t/robot/ua.t new file mode 100644 index 0000000..5f679ae --- /dev/null +++ b/t/robot/ua.t @@ -0,0 +1,151 @@ +if($^O eq "MacOS") { + print "1..0\n"; + exit(0); +} + +unless (-f "CAN_TALK_TO_OURSELF") { + print "1..0 # Skipped: Can't talk to ourself (misconfigured system)\n"; + exit; +} + +$| = 1; # autoflush +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, $^O eq 'MSWin32' ? ">nul" : $^O eq 'VMS' ? ">NL:" : ">/dev/null"); + + while ($c = $d->accept) { + $r = $c->get_request; + if ($r) { + my $p = ($r->uri->path_segments)[1]; + $p =~ s/\W//g; + my $func = lc("httpd_" . $r->method . "_$p"); + #print STDERR "Calling $func...\n"; + if (defined &$func) { + &$func($c, $r); + } + else { + $c->send_error(404); + } + } + $c = undef; # close connection + } + print STDERR "HTTP Server terminated\n"; + exit; +} +else { + use Config; + my $perl = $Config{'perlpath'}; + $perl = $^X if $^O eq 'VMS' or -x $^X and $^X =~ m,^([a-z]:)?/,i; + open(DAEMON , "$perl robot/ua.t daemon |") or die "Can't exec daemon: $!"; +} + +print "1..7\n"; + + +$greating = <DAEMON>; +$greating =~ /(<[^>]+>)/; + +require URI; +my $base = URI->new($1); +sub url { + my $u = URI->new(@_); + $u = $u->abs($_[1]) if @_ > 1; + $u->as_string; +} + +print "Will access HTTP server at $base\n"; + +require LWP::RobotUA; +require HTTP::Request; +$ua = new LWP::RobotUA 'lwp-spider/0.1', 'gisle@aas.no'; +$ua->delay(0.05); # rather quick robot + +#---------------------------------------------------------------- +sub httpd_get_robotstxt +{ + my($c,$r) = @_; + $c->send_basic_header; + $c->print("Content-Type: text/plain"); + $c->send_crlf; + $c->send_crlf; + $c->print("User-Agent: * +Disallow: /private + +"); +} + +sub httpd_get_someplace +{ + my($c,$r) = @_; + $c->send_basic_header; + $c->print("Content-Type: text/plain"); + $c->send_crlf; + $c->send_crlf; + $c->print("Okidok\n"); +} + +$req = new HTTP::Request GET => url("/someplace", $base); +$res = $ua->request($req); +#print $res->as_string; +print "not " unless $res->is_success; +print "ok 1\n"; + +$req = new HTTP::Request GET => url("/private/place", $base); +$res = $ua->request($req); +#print $res->as_string; +print "not " unless $res->code == 403 + and $res->message =~ /robots.txt/; +print "ok 2\n"; + +$req = new HTTP::Request GET => url("/foo", $base); +$res = $ua->request($req); +#print $res->as_string; +print "not " unless $res->code == 404; # not found +print "ok 3\n"; + +# Let the robotua generate "Service unavailable/Retry After response"; +$ua->delay(1); +$ua->use_sleep(0); +$req = new HTTP::Request GET => url("/foo", $base); +$res = $ua->request($req); +#print $res->as_string; +print "not " unless $res->code == 503 # Unavailable + and $res->header("Retry-After"); +print "ok 4\n"; + +#---------------------------------------------------------------- +print "Terminating server...\n"; +sub httpd_get_quit +{ + my($c) = @_; + $c->send_error(503, "Bye, bye"); + exit; # terminate HTTP server +} + +$ua->delay(0); +$req = new HTTP::Request GET => url("/quit", $base); +$res = $ua->request($req); + +print "not " unless $res->code == 503 and $res->content =~ /Bye, bye/; +print "ok 5\n"; + +#--------------------------------------------------------------- +$ua->delay(1); + +# host_wait() should be around 60s now +print "not " unless abs($ua->host_wait($base->host_port) - 60) < 5; +print "ok 6\n"; + +# Number of visits to this place should be +print "not " unless $ua->no_visits($base->host_port) == 4; +print "ok 7\n"; + |