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 | |
3356d0f6 |
9 | use HTTP::Request; |
10 | use HTTP::Request::AsCGI; |
30efa07d |
11 | use HTTP::Response; |
3356d0f6 |
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; |
30efa07d |
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 | } |
3356d0f6 |
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 | |
30efa07d |
54 | use CGI; |
3356d0f6 |
55 | use Test::More tests => 3; |
56 | |
57 | my $mech = Test::WWW::Mechanize::CGI->new; |
58 | $mech->cgi( sub { |
59 | |
3356d0f6 |
60 | my $q = CGI->new; |
61 | |
30efa07d |
62 | print $q->header, |
63 | $q->start_html('Hello World'), |
3356d0f6 |
64 | $q->h1('Hello World'), |
30efa07d |
65 | $q->end_html; |
3356d0f6 |
66 | }); |
67 | |
68 | $mech->get_ok('http://localhost/'); |
69 | $mech->title_is('Hello World'); |
70 | $mech->content_contains('Hello World'); |