src/net/http/cgi/testdata/test.cgi

   1 #!/usr/bin/perl
   2 # Copyright 2011 The Go Authors. All rights reserved.
   3 # Use of this source code is governed by a BSD-style
   4 # license that can be found in the LICENSE file.
   5 #
   6 # Test script run as a child process under cgi_test.go
   7
   8 use strict;
   9 use Cwd;
  10
  11 binmode STDOUT;
  12
  13 my $q = MiniCGI->new;
  14 my $params = $q->Vars;
  15
  16 if ($params->{"loc"}) {
  17     print "Location: $params->{loc}\r\n\r\n";
  18     exit(0);
  19 }
  20
  21 print "Content-Type: text/html\r\n";
  22 print "X-CGI-Pid: $$\r\n";
  23 print "X-Test-Header: X-Test-Value\r\n";
  24 print "\r\n";
  25
  26 if ($params->{"writestderr"}) {
  27     print STDERR "Hello, stderr!\n";
  28 }
  29
  30 if ($params->{"bigresponse"}) {
  31     # 17 MB, for OS X: golang.org/issue/4958
  32     for (1..(17 * 1024)) {
  33         print "A" x 1024, "\r\n";
  34     }
  35     exit 0;
  36 }
  37
  38 print "test=Hello CGI\r\n";
  39
  40 foreach my $k (sort keys %$params) {
  41     print "param-$k=$params->{$k}\r\n";
  42 }
  43
  44 foreach my $k (sort keys %ENV) {
  45     my $clean_env = $ENV{$k};
  46     $clean_env =~ s/[\n\r]//g;
  47     print "env-$k=$clean_env\r\n";
  48 }
  49
  50 # NOTE: msys perl returns /c/go/src/... not C:\go\....
  51 my $dir = getcwd();
  52 if ($^O eq 'MSWin32' || $^O eq 'msys' || $^O eq 'cygwin') {
  53     if ($dir =~ /^.:/) {
  54         $dir =~ s!/!\\!g;
  55     } else {
  56         my $cmd = $ENV{'COMSPEC'} || 'c:\\windows\\system32\\cmd.exe';
  57         $cmd =~ s!\\!/!g;
  58         $dir = `$cmd /c cd`;
  59         chomp $dir;
  60     }
  61 }
  62 print "cwd=$dir\r\n";
  63
  64 # A minimal version of CGI.pm, for people without the perl-modules
  65 # package installed.  (CGI.pm used to be part of the Perl core, but
  66 # some distros now bundle perl-base and perl-modules separately...)
  67 package MiniCGI;
  68
  69 sub new {
  70     my $class = shift;
  71     return bless {}, $class;
  72 }
  73
  74 sub Vars {
  75     my $self = shift;
  76     my $pairs;
  77     if ($ENV{CONTENT_LENGTH}) {
  78         $pairs = do { local $/; <STDIN> };
  79     } else {
  80         $pairs = $ENV{QUERY_STRING};
  81     }
  82     my $vars = {};
  83     foreach my $kv (split(/&/, $pairs)) {
  84         my ($k, $v) = split(/=/, $kv, 2);
  85         $vars->{_urldecode($k)} = _urldecode($v);
  86     }
  87     return $vars;
  88 }
  89
  90 sub _urldecode {
  91     my $v = shift;
  92     $v =~ tr/+/ /;
  93     $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  94     return $v;
  95 }