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 env {
  24     my $self = shift;
  25
  26     if ( @_ ) {
  27         $self->{env} = { @_ };
  28     }
  29
  30     return %{ $self->{env} || {} };
  31 }
  32
  33 sub _make_request {
  34     my ( $self, $request ) = @_;
  35
  36     if ( $self->cookie_jar ) {
  37         $self->cookie_jar->add_cookie_header($request);
  38     }
  39
  40     my %e = $self->env;
  41     my $c = HTTP::Request::AsCGI->new( $request, %e )->setup;
  42
  43     eval { $self->cgi->() };
  44
  45     my $response;
  46
  47     if ( $@ ) {
  48         $response = HTTP::Response->new(500);
  49         $response->date( time() );
  50         $response->header( 'X-Error' => $@ );
  51         $response->content( $response->error_as_HTML );
  52         $response->content_type('text/html');
  53     }
  54     else {
  55         $response = $c->restore->response;
  56     }
  57
  58     $response->header( 'Content-Base', $request->uri );
  59     $response->request($request);
  60
  61     if ( $self->cookie_jar ) {
  62         $self->cookie_jar->extract_cookies($response);
  63     }
  64
  65     return $response;
  66 }
  67
  68 package main;
  69
  70 use strict;
  71 use warnings;
  72
  73 use CGI;
  74 use Test::More tests => 3;
  75
  76 my $mech = Test::WWW::Mechanize::CGI->new;
  77 $mech->cgi( sub {
  78
  79     my $q = CGI->new;
  80
  81     print $q->header,
  82           $q->start_html('Hello World'),
  83           $q->h1('Hello World'),
  84           $q->end_html;
  85 });
  86
  87 $mech->get_ok('http://localhost/');
  88 $mech->title_is('Hello World');
  89 $mech->content_contains('Hello World');