Home | History | Annotate | Download | only in testdata 
      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 }
     96