initial commit
[fcgi] / perl / echo.PL
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
19 #  $Id: echo.PL,v 1.2 2000/12/14 13:46:23 skimo Exp $
20 #
21 # Changed by skimo to demostrate autoflushing 1997/02/19
22 #
23
24 use FCGI;
25 use strict;
26
27 sub print_env {
28     my($label, $envp) = @_;
29     print("$label:<br>\n<pre>\n");
30     my @keys = sort keys(%$envp);
31     foreach my $key (@keys) {
32         print("$key=$$envp{$key}\n");
33     }
34     print("</pre><p>\n");
35 }
36
37 my %env;
38 my $req = FCGI::Request(\*STDIN, \*STDOUT, \*STDERR, \%env);
39 my $count = 0;
40 while($req->Accept() >= 0) {
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");
45     my $len = 0 + $env{'CONTENT_LENGTH'};
46     if($len == 0) {
47         print("No data from standard input.<p>\n");
48     } else {
49         print("Standard input:<br>\n<pre>\n");
50         for(my $i = 0; $i < $len; $i++) {
51             my $ch = getc(STDIN);
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     }
61     print_env("Request environment", \%env);
62     print "More on its way ... wait a few seconds\n<BR>\n<BR>";
63     $req->Flush();
64     sleep(3);
65     print_env("Initial environment", \%ENV);
66     $req->Finish();
67 }