Improved tests

[catagits/HTTP-Request-AsCGI.git] / examples / mechanize.pl

diff --git a/examples/mechanize.pl b/examples/mechanize.pl
index 2026cf7..774ace3 100644 (file)
--- a/examples/mechanize.pl
+++ b/examples/mechanize.pl
@@ -20,12 +20,25 @@ sub cgi {
     return $self->{cgi};
 }
 
+sub env {
+    my $self = shift;
+
+    if ( @_ ) {
+        $self->{env} = { @_ };
+    }
+
+    return %{ $self->{env} || {} };
+}
+
 sub _make_request {
     my ( $self, $request ) = @_;
 
-    $self->cookie_jar->add_cookie_header($request) if $self->cookie_jar;
+    if ( $self->cookie_jar ) {
+        $self->cookie_jar->add_cookie_header($request);
+    }
 
-    my $c = HTTP::Request::AsCGI->new($request)->setup;
+    my %e = $self->env;
+    my $c = HTTP::Request::AsCGI->new( $request, %e )->setup;
 
     eval { $self->cgi->() };
 
@@ -34,15 +47,21 @@ sub _make_request {
     if ( $@ ) {
         $response = HTTP::Response->new(500);
         $response->date( time() );
+        $response->header( 'X-Error' => $@ );
         $response->content( $response->error_as_HTML );
+        $response->content_type('text/html');
     }
     else {
-        $response = $c->restore->response;   
+        $response = $c->restore->response;
     }
 
     $response->header( 'Content-Base', $request->uri );
     $response->request($request);
-    $self->cookie_jar->extract_cookies($response) if $self->cookie_jar;
+
+    if ( $self->cookie_jar ) {
+        $self->cookie_jar->extract_cookies($response);
+    }
+
     return $response;
 }