Left: | ||
Right: |
OLD | NEW |
---|---|
1 #!/usr/bin/perl | 1 #!/usr/bin/perl |
2 # Copyright 2011 The Go Authors. All rights reserved. | 2 # Copyright 2011 The Go Authors. All rights reserved. |
3 # Use of this source code is governed by a BSD-style | 3 # Use of this source code is governed by a BSD-style |
4 # license that can be found in the LICENSE file. | 4 # license that can be found in the LICENSE file. |
5 # | 5 # |
6 # Test script run as a child process under cgi_test.go | 6 # Test script run as a child process under cgi_test.go |
7 | 7 |
8 use strict; | 8 use strict; |
9 use Cwd; | 9 use Cwd; |
10 | 10 |
11 binmode STDOUT; | 11 binmode STDOUT; |
12 | 12 |
13 sub on_windows { | |
14 return $^O eq 'MSWin32' || $^O eq 'msys'; | |
15 } | |
16 | |
17 # normalize_windows_path normalizes the various Windows Perl path | |
18 # formats into Go's format. | |
19 sub normalize_windows_path { | |
20 my $dir = shift; | |
21 return $dir unless on_windows(); | |
22 print "from $dir\n"; | |
mkrautz
2012/11/19 18:33:39
Debug print?
| |
23 $dir =~ s!^[a-z]:!uc($&)!e; | |
24 print " to $dir\n"; | |
mkrautz
2012/11/19 18:33:39
Ditto.
| |
25 if ($dir =~ s!^/([a-zA-Z])/!!) { | |
26 $dir = uc($1) . ":\\$dir"; | |
27 } | |
28 print " to $dir\n"; | |
mkrautz
2012/11/19 18:33:39
Ditto.
| |
29 $dir =~ s!/!\\!g; | |
30 print " to $dir\n"; | |
mkrautz
2012/11/19 18:33:39
Ditto.
| |
31 return $dir; | |
32 } | |
33 | |
13 my $q = MiniCGI->new; | 34 my $q = MiniCGI->new; |
14 my $params = $q->Vars; | 35 my $params = $q->Vars; |
15 | 36 |
16 if ($params->{"loc"}) { | 37 if ($params->{"loc"}) { |
17 print "Location: $params->{loc}\r\n\r\n"; | 38 print "Location: $params->{loc}\r\n\r\n"; |
18 exit(0); | 39 exit(0); |
19 } | 40 } |
20 | 41 |
21 my $NL = "\r\n"; | 42 my $NL = "\r\n"; |
22 $NL = "\n" if $params->{mode} eq "NL"; | 43 $NL = "\n" if $params->{mode} eq "NL"; |
23 | 44 |
24 my $p = sub { | 45 my $p = sub { |
25 print "$_[0]$NL"; | 46 print "$_[0]$NL"; |
26 }; | 47 }; |
27 | 48 |
28 # With carriage returns | 49 # With carriage returns |
29 $p->("Content-Type: text/html"); | 50 $p->("Content-Type: text/html"); |
30 $p->("X-CGI-Pid: $$"); | 51 $p->("X-CGI-Pid: $$"); |
31 $p->("X-Test-Header: X-Test-Value"); | 52 $p->("X-Test-Header: X-Test-Value"); |
32 $p->(""); | 53 $p->(""); |
33 | 54 |
34 if ($params->{"bigresponse"}) { | 55 if ($params->{"bigresponse"}) { |
35 for (1..1024) { | 56 for (1..1024) { |
36 print "A" x 1024, "\n"; | 57 print "A" x 1024, "\n"; |
37 } | 58 } |
38 exit 0; | 59 exit 0; |
39 } | 60 } |
40 | 61 |
41 print "test=Hello CGI\n"; | 62 print "test=Hello CGI\n"; |
42 | 63 |
43 foreach my $k (sort keys %$params) { | 64 foreach my $k (sort keys %$params) { |
44 print "param-$k=$params->{$k}\n"; | 65 print "param-$k=$params->{$k}\n"; |
45 } | 66 } |
46 | 67 |
47 foreach my $k (sort keys %ENV) { | 68 foreach my $k (sort keys %ENV) { |
48 my $clean_env = $ENV{$k}; | 69 my $clean_env = $ENV{$k}; |
49 $clean_env =~ s/[\n\r]//g; | 70 $clean_env =~ s/[\n\r]//g; |
50 print "env-$k=$clean_env\n"; | 71 print "env-$k=$clean_env\n"; |
51 } | 72 } |
52 | 73 |
53 # NOTE: don't call getcwd() for windows. | 74 my $dir = ::normalize_windows_path(getcwd()); |
54 # msys return /c/go/src/... not C:\go\... | |
55 my $dir; | |
56 if ($^O eq 'MSWin32' || $^O eq 'msys') { | |
57 my $cmd = $ENV{'COMSPEC'} || 'c:\\windows\\system32\\cmd.exe'; | |
58 $cmd =~ s!\\!/!g; | |
59 $dir = `$cmd /c cd`; | |
60 chomp $dir; | |
61 } else { | |
62 $dir = getcwd(); | |
63 } | |
64 print "cwd=$dir\n"; | 75 print "cwd=$dir\n"; |
65 | 76 |
66 | |
67 # A minimal version of CGI.pm, for people without the perl-modules | 77 # A minimal version of CGI.pm, for people without the perl-modules |
68 # package installed. (CGI.pm used to be part of the Perl core, but | 78 # package installed. (CGI.pm used to be part of the Perl core, but |
69 # some distros now bundle perl-base and perl-modules separately...) | 79 # some distros now bundle perl-base and perl-modules separately...) |
70 package MiniCGI; | 80 package MiniCGI; |
71 | 81 |
72 sub new { | 82 sub new { |
73 my $class = shift; | 83 my $class = shift; |
74 return bless {}, $class; | 84 return bless {}, $class; |
75 } | 85 } |
76 | 86 |
(...skipping 12 matching lines...) Expand all Loading... | |
89 } | 99 } |
90 return $vars; | 100 return $vars; |
91 } | 101 } |
92 | 102 |
93 sub _urldecode { | 103 sub _urldecode { |
94 my $v = shift; | 104 my $v = shift; |
95 $v =~ tr/+/ /; | 105 $v =~ tr/+/ /; |
96 $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; | 106 $v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; |
97 return $v; | 107 return $v; |
98 } | 108 } |
109 | |
110 package Tests; | |
111 | |
112 sub test_normalize_windows_paths { | |
113 my @tests = ( | |
114 {in => "C:\\foo\\bar", want => "C:\\foo\\bar"}, | |
115 {in => "C:/foo/bar", want => "C:\\foo\\bar"}, | |
116 {in => "c:/foo/bar", want => "C:\\foo\\bar"}, | |
117 {in => "/c/foo/bar", want => "C:\\foo\\bar"}, | |
118 ); | |
119 foreach my $tt (@tests) { | |
120 my $got = ::normalize_windows_path($tt->{in}); | |
121 unless ($got eq $tt->{want}) { | |
122 die "For path $tt->{in}, normalize = $got; want $tt->{want}\n"; | |
123 } | |
124 } | |
125 } | |
126 | |
127 BEGIN { | |
128 test_normalize_windows_paths() if ::on_windows(); | |
129 } | |
OLD | NEW |