1use strict; 2use Test::More; 3use LWP::UserAgent; 4use LWP::Protocol::PSGI; 5 6my $psgi_app = sub { 7 my $env = shift; 8 return [ 9 200, 10 [ 11 "Content-Type", "text/plain", 12 "X-Foo" => "bar", 13 ], 14 [ "query=$env->{QUERY_STRING}" ], 15 ]; 16}; 17 18{ 19 my $guard = LWP::Protocol::PSGI->register($psgi_app); 20 21 my $ua = LWP::UserAgent->new; 22 my $res = $ua->get("http://www.google.com/search?q=bar"); 23 is $res->content, "query=q=bar"; 24 is $res->header('X-Foo'), "bar"; 25 26 use LWP::Simple; 27 my $body = get "http://www.google.com/?q=x"; 28 is $body, "query=q=x"; 29} 30 31{ 32 my $g = LWP::Protocol::PSGI->register($psgi_app, host => 'www.google.com'); 33 my $ua = LWP::UserAgent->new; 34 my $res = $ua->get("http://www.google.com/search?q=bar"); 35 is $res->content, "query=q=bar"; 36} 37 38{ 39 my $guard1 = LWP::Protocol::PSGI->register($psgi_app); 40 my $ua = LWP::UserAgent->new; 41 my $res = $ua->get("http://www.google.com/search?q=bar"); 42 is $res->content, "query=q=bar"; 43 44 { 45 my $guard2 = LWP::Protocol::PSGI->register(sub { [ 403, [ "Content-Type" => "text/plain" ], [ "Not here" ] ] }, host => "www.yahoo.com"); 46 $res = $ua->get("http://www.google.com/search?q=bar"); 47 is $res->content, "query=q=bar"; 48 $res = $ua->get("http://www.yahoo.com/search?q=bar"); 49 is $res->content, "Not here"; 50 } 51 52 # guard2 expired 53 $res = $ua->get("http://www.google.com/search?q=bar"); 54 is $res->content, "query=q=bar"; 55 $res = $ua->get("http://www.yahoo.com/search?q=bar"); 56 is $res->content, "query=q=bar"; 57} 58 59 60 61sub test_match { 62 my($uri, %options) = @_; 63 my $p = LWP::Protocol::PSGI->register(sub { }, %options); 64 my $ok = LWP::Protocol::PSGI->handles(HTTP::Request->new(GET => $uri)); 65 undef $p; 66 return $ok; 67} 68 69ok( test_match 'http://www.google.com/', host => 'www.google.com' ); 70ok( test_match 'https://www.google.com/', host => 'www.google.com' ); 71ok( test_match 'https://www.google.com/', host => qr/\.google.com/ ); 72ok( test_match 'https://www.google.com/', host => sub { $_[0] eq 'www.google.com' } ); 73 74ok( !test_match 'http://www.google.com/', host => 'google.com' ); 75ok( !test_match 'https://www.apple.com/', host => qr/\.google.com/ ); 76ok( !test_match 'https://google.com/', host => sub { $_[0] eq 'www.google.com' } ); 77 78ok( test_match 'http://www.google.com/', uri => 'http://www.google.com/' ); 79ok( test_match 'https://www.google.com/search?q=bar', uri => 'https://www.google.com/search?q=bar' ); 80ok( test_match 'https://www.google.com/search', uri => qr/\.google.com/ ); 81ok( test_match 'https://www.google.com/', uri => sub { $_[0] =~ /www.google.com/ } ); 82 83done_testing; 84 85