Commit | Line | Data |
1b64d24d |
1 | use Config; |
2 | |
3 | open OUT, ">echo.fpl"; |
4 | print OUT "#!$Config{perlpath}\n"; |
5 | print OUT while <DATA>; |
6 | close OUT; |
7 | chmod 0755, "echo.fpl"; |
8 | __END__ |
9 | # |
10 | # echo-perl -- |
11 | # |
12 | # Produce a page containing all FastCGI inputs |
13 | # |
14 | # Copyright (c) 1996 Open Market, Inc. |
15 | # |
16 | # See the file "LICENSE.TERMS" for information on usage and redistribution |
17 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
18 | # |
48cdf763 |
19 | # $Id: echo.PL,v 1.2 2000/12/14 13:46:23 skimo Exp $ |
1b64d24d |
20 | # |
21 | # Changed by skimo to demostrate autoflushing 1997/02/19 |
22 | # |
23 | |
24 | use FCGI; |
48cdf763 |
25 | use strict; |
1b64d24d |
26 | |
27 | sub print_env { |
28 | my($label, $envp) = @_; |
29 | print("$label:<br>\n<pre>\n"); |
30 | my @keys = sort keys(%$envp); |
48cdf763 |
31 | foreach my $key (@keys) { |
1b64d24d |
32 | print("$key=$$envp{$key}\n"); |
33 | } |
34 | print("</pre><p>\n"); |
35 | } |
36 | |
48cdf763 |
37 | my %env; |
38 | my $req = FCGI::Request(\*STDIN, \*STDOUT, \*STDERR, \%env); |
39 | my $count = 0; |
40 | while($req->Accept() >= 0) { |
1b64d24d |
41 | print("Content-type: text/html\r\n\r\n", |
42 | "<title>FastCGI echo (Perl)</title>\n", |
43 | "<h1>FastCGI echo (Perl)</h1>\n", |
44 | "Request number ", ++$count, "<p>\n"); |
48cdf763 |
45 | my $len = 0 + $env{'CONTENT_LENGTH'}; |
1b64d24d |
46 | if($len == 0) { |
47 | print("No data from standard input.<p>\n"); |
48 | } else { |
49 | print("Standard input:<br>\n<pre>\n"); |
48cdf763 |
50 | for(my $i = 0; $i < $len; $i++) { |
51 | my $ch = getc(STDIN); |
1b64d24d |
52 | if($ch eq "") { |
53 | print("Error: Not enough bytes received ", |
54 | "on standard input<p>\n"); |
55 | last; |
56 | } |
57 | print($ch); |
58 | } |
59 | print("\n</pre><p>\n"); |
60 | } |
48cdf763 |
61 | print_env("Request environment", \%env); |
1b64d24d |
62 | print "More on its way ... wait a few seconds\n<BR>\n<BR>"; |
48cdf763 |
63 | $req->Flush(); |
1b64d24d |
64 | sleep(3); |
48cdf763 |
65 | print_env("Initial environment", \%ENV); |
66 | $req->Finish(); |
1b64d24d |
67 | } |