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 CGI;
  10 use HTTP::Request;
  11 use HTTP::Request::AsCGI;
  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     $self->cgi->();
  30     my $response = $c->restore->response;
  31
  32     $response->header( 'Content-Base', $request->uri );
  33     $response->request($request);
  34     $self->cookie_jar->extract_cookies($response) if $self->cookie_jar;
  35     return $response;
  36 }
  37
  38 package main;
  39
  40 use strict;
  41 use warnings;
  42
  43 use Test::More tests => 3;
  44
  45 my $mech = Test::WWW::Mechanize::CGI->new;
  46 $mech->cgi( sub {
  47
  48     CGI::initialize_globals();
  49
  50     my $q = CGI->new;
  51
  52     print $q->header,
  53           $q->start_html('Hello World'),
  54           $q->h1('Hello World'),
  55           $q->end_html;
  56 });
  57
  58 $mech->get_ok('http://localhost/');
  59 $mech->title_is('Hello World');
  60 $mech->content_contains('Hello World');