Commit | Line | Data |
3cdea3c7 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use CGI; |
7 | use HTTP::Daemon; |
8 | use HTTP::Request; |
9 | use HTTP::Request::AsCGI; |
10 | use HTTP::Response; |
30efa07d |
11 | use URI; |
3cdea3c7 |
12 | |
f93fc77c |
13 | $SIG{'PIPE'} = 'IGNORE'; |
14 | |
30efa07d |
15 | my $server = HTTP::Daemon->new( LocalPort => 3000, ReuseAddr => 1 ) |
16 | or die( "Can't create daemon: $!" ); |
3cdea3c7 |
17 | |
18 | print "Please contact me at: <URL:", $server->url, ">\n"; |
19 | |
20 | while ( my $client = $server->accept ) { |
f93fc77c |
21 | |
22 | my %e = ( |
23 | REMOTE_ADDR => $client->peerhost, |
24 | REMOTE_HOST => $client->peerhost, |
25 | REMOTE_PORT => $client->peerport |
26 | ); |
3cdea3c7 |
27 | |
28 | while ( my $request = $client->get_request ) { |
29 | |
30efa07d |
30 | unless ( $request->uri->host ) { |
31 | $request->uri( URI->new_abs( $request->uri, $server->url ) ); |
32 | } |
780060e5 |
33 | |
f93fc77c |
34 | my $c = HTTP::Request::AsCGI->new( $request, %e )->setup; |
3cdea3c7 |
35 | my $q = CGI->new; |
36 | |
3356d0f6 |
37 | print $q->header( -charset => 'UTF-8' ), |
38 | $q->start_html( |
39 | -title => 'Hello World', |
40 | -encoding => 'UTF-8' |
41 | ), |
3cdea3c7 |
42 | $q->h1('Hello World'), |
3356d0f6 |
43 | $q->start_form, |
44 | $q->table( |
45 | $q->Tr( [ |
46 | $q->td( [ 'Name', $q->textfield( -name => 'name' ) ] ), |
47 | $q->td( [ 'Email', $q->textfield( -name => 'email' ) ] ), |
48 | $q->td( [ 'Phone', $q->textfield( -name => 'phone' ) ] ), |
49 | $q->td( [ 'File', $q->filefield( -name => 'file' ) ] ) |
50 | ] ) |
51 | ), |
52 | $q->submit, |
53 | $q->end_form, |
30efa07d |
54 | $q->h2('Parameters'), |
3356d0f6 |
55 | $q->Dump, |
30efa07d |
56 | $q->h2('Enviroment'), |
57 | $q->table( |
58 | $q->Tr( [ |
59 | map{ $q->td( [ $_, $ENV{$_} ] ) } sort keys %ENV |
60 | ] ) |
61 | ), |
3cdea3c7 |
62 | $q->end_html; |
63 | |
3356d0f6 |
64 | my $response = $c->restore->response; |
3cdea3c7 |
65 | |
3356d0f6 |
66 | # tell client to close socket to prevent blocking problems |
67 | # in this single threaded daemon. |
f93fc77c |
68 | $response->header( Connection => 'close' ); |
3cdea3c7 |
69 | |
70 | $client->send_response($response); |
71 | } |
72 | |
780060e5 |
73 | $client->close; |
3cdea3c7 |
74 | } |