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