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     $self->cookie_jar->add_cookie_header($request) if $self->cookie_jar;
  27
  28     my $c = HTTP::Request::AsCGI->new($request)->setup;
  29
  30     eval { $self->cgi->() };
  31
  32     my $response;
  33
  34     if ( $@ ) {
  35         $response = HTTP::Response->new(500);
  36         $response->date( time() );
  37         $response->content( $response->error_as_HTML );
  38     }
  39     else {
  40         $response = $c->restore->response;
  41     }
  42
  43     $response->header( 'Content-Base', $request->uri );
  44     $response->request($request);
  45     $self->cookie_jar->extract_cookies($response) if $self->cookie_jar;
  46     return $response;
  47 }
  48
  49 package main;
  50
  51 use strict;
  52 use warnings;
  53
  54 use CGI;
  55 use Test::More tests => 3;
  56
  57 my $mech = Test::WWW::Mechanize::CGI->new;
  58 $mech->cgi( sub {
  59
  60     my $q = CGI->new;
  61
  62     print $q->header,
  63           $q->start_html('Hello World'),
  64           $q->h1('Hello World'),
  65           $q->end_html;
  66 });
  67
  68 $mech->get_ok('http://localhost/');
  69 $mech->title_is('Hello World');
  70 $mech->content_contains('Hello World');