github.com/guyezi/gofrontend@v0.0.0-20200228202240-7a62a49e62c0/libgo/go/net/http/cgi/testdata/test.cgi (about) 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 }