git.maemo.org Git - pkg-perl/blob - deb-src/libwww-mechanize-perl/libwww-mechanize-perl-1.34/t/local/referer.t

   1 #!/usr/bin/perl -w
   2
   3 use warnings;
   4 use strict;
   5 use FindBin;
   6
   7 use Test::More tests => 13;
   8
   9 BEGIN {
  10     delete @ENV{ grep { lc eq 'http_proxy' } keys %ENV };
  11     delete @ENV{ qw( IFS CDPATH ENV BASH_ENV ) };
  12     use_ok( 'WWW::Mechanize' );
  13 }
  14
  15 our $server;
  16 my $agent = WWW::Mechanize->new();
  17 isa_ok( $agent, 'WWW::Mechanize' );
  18
  19 SKIP: {
  20     eval { require HTTP::Daemon; };
  21     skip 'HTTP::Daemon required to test the referrer header',10 if $@;
  22
  23     # We want to be safe from non-resolving local host names
  24     delete $ENV{HTTP_PROXY};
  25
  26     # Now start a fake webserver, fork, and connect to ourselves
  27     my $command = qq'"$^X" "$FindBin::Bin/referer-server"';
  28     if ($^O eq 'VMS') {
  29         $command = qq'mcr $^X t/referer-server';
  30     }
  31
  32     open $server, "$command |" or die "Couldn't spawn fake server: $!";
  33     sleep 1; # give the child some time
  34     my $url = <$server>;
  35     chomp $url;
  36
  37     $agent->get( $url );
  38     is($agent->status, 200, 'Got first page') or diag $agent->res->message;
  39     is($agent->content, q{Referer: ''}, 'First page gets sent with empty referrer');
  40
  41     $agent->get( $url );
  42     is($agent->status, 200, 'Got second page') or diag $agent->res->message;
  43     is($agent->content, "Referer: '$url'", 'Referer got sent for absolute url');
  44
  45     $agent->get( '.' );
  46     is($agent->status, 200, 'Got third page') or diag $agent->res->message;
  47     is($agent->content, "Referer: '$url'", 'Referer got sent for relative url');
  48
  49     $agent->add_header( Referer => 'x' );
  50     $agent->get( $url );
  51     is($agent->status, 200, 'Got fourth page') or diag $agent->res->message;
  52     is($agent->content, q{Referer: 'x'}, 'Referer can be set to empty again');
  53
  54     my $ref = 'This is not the referer you are looking for *jedi gesture*';
  55     $agent->add_header( Referer => $ref );
  56     $agent->get( $url );
  57     is($agent->status, 200, 'Got fourth page') or diag $agent->res->message;
  58     is($agent->content, "Referer: '$ref'", 'Custom referer can be set');
  59 };
  60
  61 SKIP: {
  62     eval 'use Test::Memory::Cycle';
  63     skip 'Test::Memory::Cycle not installed', 1 if $@;
  64
  65     memory_cycle_ok( $agent, 'No memory cycles found' );
  66 }
  67
  68 END {
  69     close $server if $server;
  70 };