"Fossies" - the Fresh Open Source Software Archive

Member "libwww-perl-6.43/t/base/ua_handlers.t" (26 Nov 2019, 1338 Bytes) of package /linux/www/libwww-perl-6.43.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 use strict;
    2 use warnings;
    3 use Test::More;
    4 use LWP::UserAgent ();
    5 use HTTP::Request ();
    6 use HTTP::Response ();
    7 
    8 # Prevent environment from interfering with test:
    9 delete $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME};
   10 delete $ENV{HTTPS_CA_FILE};
   11 delete $ENV{HTTPS_CA_DIR};
   12 delete $ENV{PERL_LWP_SSL_CA_FILE};
   13 delete $ENV{PERL_LWP_SSL_CA_PATH};
   14 delete $ENV{PERL_LWP_ENV_PROXY};
   15 
   16 my $ua = LWP::UserAgent->new;
   17 $ua->add_handler(
   18     request_send => sub {
   19         my ($request, $ua, $handler) = @_;
   20         return HTTP::Response->new(200,'OK',[],'ok');
   21     }
   22 );
   23 
   24 subtest 'request_send' => sub {
   25     my $res = $ua->get('http://www.example.com');
   26     ok($res->is_success, 'handler should succeed');
   27     is($res->content,'ok','handler-provided response should be used');
   28 };
   29 
   30 subtest 'request_prepare' => sub {
   31     $ua->add_handler(
   32         request_prepare => sub {
   33             # the docs say this is the way to replace the request
   34             $_[0] = HTTP::Request->new(POST=>'http://mmm.example.com/');
   35         }
   36     );
   37     my $res = $ua->get('http://www.example.com');
   38     my $effective_request = $res->request;
   39     is($effective_request->method,'POST',
   40        'the request should have been modified by the handler');
   41     is($effective_request->uri,'http://mmm.example.com/',
   42        'the request should have been modified by the handler');
   43 };
   44 
   45 done_testing;