Commit | Line | Data |
3356d0f6 |
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'); |