added two examples
Christian Hansen [Sun, 16 Oct 2005 13:17:34 +0000 (13:17 +0000)]
examples/daemon.pl [new file with mode: 0644]
examples/synopsis.pl [new file with mode: 0644]
lib/HTTP/Request/AsCGI.pm

diff --git a/examples/daemon.pl b/examples/daemon.pl
new file mode 100644 (file)
index 0000000..083afd1
--- /dev/null
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use CGI;
+use HTTP::Daemon;
+use HTTP::Request;
+use HTTP::Request::AsCGI;
+use HTTP::Response;
+
+my $server = HTTP::Daemon->new || die;
+
+print "Please contact me at: <URL:", $server->url, ">\n";
+
+while ( my $client = $server->accept ) {
+
+    while ( my $request = $client->get_request ) {
+
+        my $c = HTTP::Request::AsCGI->new($request)->setup;
+        my $q = CGI->new;
+
+        print $q->header, 
+              $q->start_html('Hello World'), 
+              $q->h1('Hello World'),
+              $q->end_html;
+
+        $c->restore;
+
+        my $message = "HTTP/1.1 200 OK\x0d\x0a";
+
+        while ( my $line = $c->stdout->getline ) {
+            $message .= $line;
+            last if $line =~ /^\x0d?\x0a$/;
+        }
+
+        my $response = HTTP::Response->parse($message);
+        $response->content( sub {
+            if ( $c->stdout->read( my $buffer, 4096 ) ) {
+                return $buffer;
+            }
+            return undef;
+        });
+
+        $client->send_response($response);
+    }
+
+    $client->close;
+}
diff --git a/examples/synopsis.pl b/examples/synopsis.pl
new file mode 100644 (file)
index 0000000..2106a1e
--- /dev/null
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use CGI;
+use HTTP::Request;
+use HTTP::Request::AsCGI;
+
+my $request = HTTP::Request->new( GET => 'http://www.host.com/' );
+my $stdout;
+
+{
+    my $c = HTTP::Request::AsCGI->new($request)->setup;
+    my $q = CGI->new;
+
+    print $q->header,
+          $q->start_html('Hello World'),
+          $q->h1('Hello World'),
+          $q->end_html;
+
+    $stdout = $c->stdout;
+
+    # enviroment and descriptors will automatically be restored when $c is destructed.
+}
+
+while ( my $line = $stdout->getline ) {
+    print $line;
+}
index f7b3b12..ccae2b4 100644 (file)
@@ -83,7 +83,10 @@ sub setup {
           or croak("Can't seek stdin: $!");
     }
 
-    %ENV = %{ $self->enviroment };
+    {
+        no warnings 'uninitialized';
+        %ENV = %{ $self->enviroment };
+    }
 
     open( STDIN, '<&=', $self->stdin->fileno )
       or croak("Can't open stdin: $!");