Add the original source packages to maemo, source lenny

[dh-make-perl] / dev / i386 / libwww-mechanize-perl / libwww-mechanize-perl-1.34 / t / local / referer.t

diff --git a/dev/i386/libwww-mechanize-perl/libwww-mechanize-perl-1.34/t/local/referer.t b/dev/i386/libwww-mechanize-perl/libwww-mechanize-perl-1.34/t/local/referer.t
new file mode 100644 (file)
index 0000000..8c2f68d
--- /dev/null
+++ b/dev/i386/libwww-mechanize-perl/libwww-mechanize-perl-1.34/t/local/referer.t
@@ -0,0 +1,70 @@
+#!/usr/bin/perl -w
+
+use warnings;
+use strict;
+use FindBin;
+
+use Test::More tests => 13;
+
+BEGIN {
+    delete @ENV{ grep { lc eq 'http_proxy' } keys %ENV };
+    delete @ENV{ qw( IFS CDPATH ENV BASH_ENV ) };
+    use_ok( 'WWW::Mechanize' );
+}
+
+our $server;
+my $agent = WWW::Mechanize->new();
+isa_ok( $agent, 'WWW::Mechanize' );
+
+SKIP: {
+    eval { require HTTP::Daemon; };
+    skip 'HTTP::Daemon required to test the referrer header',10 if $@;
+
+    # We want to be safe from non-resolving local host names
+    delete $ENV{HTTP_PROXY};
+
+    # Now start a fake webserver, fork, and connect to ourselves
+    my $command = qq'"$^X" "$FindBin::Bin/referer-server"';
+    if ($^O eq 'VMS') {
+        $command = qq'mcr $^X t/referer-server';
+    }
+
+    open $server, "$command |" or die "Couldn't spawn fake server: $!";
+    sleep 1; # give the child some time
+    my $url = <$server>;
+    chomp $url;
+
+    $agent->get( $url );
+    is($agent->status, 200, 'Got first page') or diag $agent->res->message;
+    is($agent->content, q{Referer: ''}, 'First page gets sent with empty referrer');
+
+    $agent->get( $url );
+    is($agent->status, 200, 'Got second page') or diag $agent->res->message;
+    is($agent->content, "Referer: '$url'", 'Referer got sent for absolute url');
+
+    $agent->get( '.' );
+    is($agent->status, 200, 'Got third page') or diag $agent->res->message;
+    is($agent->content, "Referer: '$url'", 'Referer got sent for relative url');
+
+    $agent->add_header( Referer => 'x' );
+    $agent->get( $url );
+    is($agent->status, 200, 'Got fourth page') or diag $agent->res->message;
+    is($agent->content, q{Referer: 'x'}, 'Referer can be set to empty again');
+
+    my $ref = 'This is not the referer you are looking for *jedi gesture*';
+    $agent->add_header( Referer => $ref );
+    $agent->get( $url );
+    is($agent->status, 200, 'Got fourth page') or diag $agent->res->message;
+    is($agent->content, "Referer: '$ref'", 'Custom referer can be set');
+};
+
+SKIP: {
+    eval 'use Test::Memory::Cycle';
+    skip 'Test::Memory::Cycle not installed', 1 if $@;
+
+    memory_cycle_ok( $agent, 'No memory cycles found' );
+}
+
+END {
+    close $server if $server;
+};