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 }