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; |
11 | |
f93fc77c |
12 | $SIG{'PIPE'} = 'IGNORE'; |
13 | |
14 | my $server = HTTP::Daemon->new( LocalPort => 3000, ReuseAddr => 1 ) || die; |
3cdea3c7 |
15 | |
16 | print "Please contact me at: <URL:", $server->url, ">\n"; |
17 | |
18 | while ( my $client = $server->accept ) { |
f93fc77c |
19 | |
20 | my %e = ( |
21 | REMOTE_ADDR => $client->peerhost, |
22 | REMOTE_HOST => $client->peerhost, |
23 | REMOTE_PORT => $client->peerport |
24 | ); |
3cdea3c7 |
25 | |
26 | while ( my $request = $client->get_request ) { |
27 | |
2aaf55bc |
28 | CGI::initialize_globals(); |
29 | |
780060e5 |
30 | $request->uri->scheme('http'); |
31 | $request->uri->host_port( $request->header('Host') || URI->new($server)->host_port ); |
32 | |
f93fc77c |
33 | my $c = HTTP::Request::AsCGI->new( $request, %e )->setup; |
3cdea3c7 |
34 | my $q = CGI->new; |
35 | |
3356d0f6 |
36 | print $q->header( -charset => 'UTF-8' ), |
37 | $q->start_html( |
38 | -title => 'Hello World', |
39 | -encoding => 'UTF-8' |
40 | ), |
3cdea3c7 |
41 | $q->h1('Hello World'), |
3356d0f6 |
42 | $q->start_form, |
43 | $q->table( |
44 | $q->Tr( [ |
45 | $q->td( [ 'Name', $q->textfield( -name => 'name' ) ] ), |
46 | $q->td( [ 'Email', $q->textfield( -name => 'email' ) ] ), |
47 | $q->td( [ 'Phone', $q->textfield( -name => 'phone' ) ] ), |
48 | $q->td( [ 'File', $q->filefield( -name => 'file' ) ] ) |
49 | ] ) |
50 | ), |
51 | $q->submit, |
52 | $q->end_form, |
53 | $q->h2('Params'), |
54 | $q->Dump, |
3cdea3c7 |
55 | $q->end_html; |
56 | |
3356d0f6 |
57 | my $response = $c->restore->response; |
3cdea3c7 |
58 | |
3356d0f6 |
59 | # tell client to close socket to prevent blocking problems |
60 | # in this single threaded daemon. |
f93fc77c |
61 | $response->header( Connection => 'close' ); |
3cdea3c7 |
62 | |
63 | $client->send_response($response); |
64 | } |
65 | |
780060e5 |
66 | $client->close; |
3cdea3c7 |
67 | } |