libgo/go/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 my $q = MiniCGI->new;
  12 my $params = $q->Vars;
  13
  14 if ($params->{"loc"}) {
  15     print "Location: $params->{loc}\r\n\r\n";
  16     exit(0);
  17 }
  18
  19 my $NL = "\r\n";
  20 $NL = "\n" if $params->{mode} eq "NL";
  21
  22 my $p = sub {
  23   print "$_[0]$NL";
  24 };
  25
  26 # With carriage returns
  27 $p->("Content-Type: text/html");
  28 $p->("X-CGI-Pid: $$");
  29 $p->("X-Test-Header: X-Test-Value");
  30 $p->("");
  31
  32 if ($params->{"bigresponse"}) {
  33     for (1..1024) {
  34         print "A" x 1024, "\n";
  35     }
  36     exit 0;
  37 }
  38
  39 print "test=Hello CGI\n";
  40
  41 foreach my $k (sort keys %$params) {
  42   print "param-$k=$params->{$k}\n";
  43 }
  44
  45 foreach my $k (sort keys %ENV) {
  46   my $clean_env = $ENV{$k};
  47   $clean_env =~ s/[\n\r]//g;
  48   print "env-$k=$clean_env\n";
  49 }
  50
  51 # NOTE: don't call getcwd() for windows.
  52 # msys return /c/go/src/... not C:\go\...
  53 my $dir;
  54 if ($^O eq 'MSWin32' || $^O eq 'msys') {
  55   my $cmd = $ENV{'COMSPEC'} || 'c:\\windows\\system32\\cmd.exe';
  56   $cmd =~ s!\\!/!g;
  57   $dir = `$cmd /c cd`;
  58   chomp $dir;
  59 } else {
  60   $dir = getcwd();
  61 }
  62 print "cwd=$dir\n";
  63
  64
  65 # A minimal version of CGI.pm, for people without the perl-modules
  66 # package installed.  (CGI.pm used to be part of the Perl core, but
  67 # some distros now bundle perl-base and perl-modules separately...)
  68 package MiniCGI;
  69
  70 sub new {
  71     my $class = shift;
  72     return bless {}, $class;
  73 }
  74
  75 sub Vars {
  76     my $self = shift;
  77     my $pairs;
  78     if ($ENV{CONTENT_LENGTH}) {
  79         $pairs = do { local $/; <STDIN> };
  80     } else {
  81         $pairs = $ENV{QUERY_STRING};
  82     }
  83     my $vars = {};
  84     foreach my $kv (split(/&/, $pairs)) {
  85         my ($k, $v) = split(/=/, $kv, 2);
  86         $vars->{_urldecode($k)} = _urldecode($v);
  87     }
  88     return $vars;
  89 }
  90
  91 sub _urldecode {
  92     my $v = shift;
  93     $v =~ tr/+/ /;
  94     $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  95     return $v;
  96 }