examples/mechanize.pl

   1 #!/usr/bin/perl
   2
   3 package Test::WWW::Mechanize::CGI;
   4
   5 use strict;
   6 use warnings;
   7 use base 'Test::WWW::Mechanize';
   8
   9 use HTTP::Request;
  10 use HTTP::Request::AsCGI;
  11 use HTTP::Response;
  12
  13 sub cgi {
  14     my $self = shift;
  15
  16     if ( @_ ) {
  17         $self->{cgi} = shift;
  18     }
  19
  20     return $self->{cgi};
  21 }
  22
  23 sub _make_request {
  24     my ( $self, $request ) = @_;
  25
  26     if ( $self->cookie_jar ) {
  27         $self->cookie_jar->add_cookie_header($request);
  28     }
  29
  30     my $c = HTTP::Request::AsCGI->new($request)->setup;
  31
  32     eval { $self->cgi->() };
  33
  34     my $response;
  35
  36     if ( $@ ) {
  37         $response = HTTP::Response->new(500);
  38         $response->date( time() );
  39         $response->content( $response->error_as_HTML );
  40     }
  41     else {
  42         $response = $c->restore->response;
  43     }
  44
  45     $response->header( 'Content-Base', $request->uri );
  46     $response->request($request);
  47
  48     if ( $self->cookie_jar ) {
  49         $self->cookie_jar->extract_cookies($response);
  50     }
  51
  52     return $response;
  53 }
  54
  55 package main;
  56
  57 use strict;
  58 use warnings;
  59
  60 use CGI;
  61 use Test::More tests => 3;
  62
  63 my $mech = Test::WWW::Mechanize::CGI->new;
  64 $mech->cgi( sub {
  65
  66     my $q = CGI->new;
  67
  68     print $q->header,
  69           $q->start_html('Hello World'),
  70           $q->h1('Hello World'),
  71           $q->end_html;
  72 });
  73
  74 $mech->get_ok('http://localhost/');
  75 $mech->title_is('Hello World');
  76 $mech->content_contains('Hello World');