added mechanize.pl example

diff --git a/MANIFEST b/MANIFEST
index 6ba9f96..7a46449 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,5 +1,6 @@
 lib/HTTP/Request/AsCGI.pm
 examples/daemon.pl
+examples/mechanize.pl
 examples/synopsis.pl
 t/01use.t
 t/04io.t

diff --git a/examples/daemon.pl b/examples/daemon.pl
index 11a51d6..a946d07 100644 (file)
--- a/examples/daemon.pl
+++ b/examples/daemon.pl
@@ -33,16 +33,31 @@ while ( my $client = $server->accept ) {
         my $c = HTTP::Request::AsCGI->new( $request, %e )->setup;
         my $q = CGI->new;
 
-        print $q->header,
-              $q->start_html('Hello World'),
+        print $q->header( -charset => 'UTF-8' ),
+              $q->start_html( 
+                  -title    => 'Hello World',
+                  -encoding => 'UTF-8'
+              ),
               $q->h1('Hello World'),
+              $q->start_form,
+              $q->table(
+                  $q->Tr( [
+                      $q->td( [ 'Name',  $q->textfield( -name => 'name'  ) ] ),
+                      $q->td( [ 'Email', $q->textfield( -name => 'email' ) ] ),
+                      $q->td( [ 'Phone', $q->textfield( -name => 'phone' ) ] ),
+                      $q->td( [ 'File',  $q->filefield( -name => 'file'  ) ] )
+                  ] )
+              ),
+              $q->submit,
+              $q->end_form,
+              $q->h2('Params'),
+              $q->Dump,
               $q->end_html;
 
-        $c->restore;
+        my $response = $c->restore->response;
 
-        my $response = $c->response;
-
-        # to prevent blocking problems in single threaded daemon.
+        # tell client to close socket to prevent blocking problems
+        # in this single threaded daemon.
         $response->header( Connection => 'close' );
 
         $client->send_response($response);

diff --git a/examples/mechanize.pl b/examples/mechanize.pl
new file mode 100644 (file)
index 0000000..2e19291
--- /dev/null
+++ b/examples/mechanize.pl
@@ -0,0 +1,60 @@
+#!/usr/bin/perl
+
+package Test::WWW::Mechanize::CGI;
+
+use strict;
+use warnings;
+use base 'Test::WWW::Mechanize';
+
+use CGI;
+use HTTP::Request;
+use HTTP::Request::AsCGI;
+
+sub cgi {
+    my $self = shift;
+
+    if ( @_ ) {
+        $self->{cgi} = shift;
+    }
+
+    return $self->{cgi};
+}
+
+sub _make_request {
+    my ( $self, $request ) = @_;
+
+    $self->cookie_jar->add_cookie_header($request) if $self->cookie_jar;
+
+    my $c = HTTP::Request::AsCGI->new($request)->setup;
+    $self->cgi->();
+    my $response = $c->restore->response;
+
+    $response->header( 'Content-Base', $request->uri );
+    $response->request($request);
+    $self->cookie_jar->extract_cookies($response) if $self->cookie_jar;
+    return $response;
+}
+
+package main;
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+
+my $mech = Test::WWW::Mechanize::CGI->new;
+$mech->cgi( sub {
+
+    CGI::initialize_globals();
+
+    my $q = CGI->new;
+
+    print $q->header, 
+          $q->start_html('Hello World'), 
+          $q->h1('Hello World'),
+          $q->end_html;   
+});
+
+$mech->get_ok('http://localhost/');
+$mech->title_is('Hello World');
+$mech->content_contains('Hello World');