Perl/\347\222\260\345\242\203\345\244\211\346\225\260.md
... ...
@@ -24,17 +24,12 @@ use strict;
24 24
use warnings;
25 25
use utf8;
26 26
use Encode;
27
-use CGI::Pretty qw( -no_xhtml *table ); # //HTML 4.01 Transitional//EN
28
-
29
-my $charsetConsole = 'UTF-8';
30
-my $charsetFile = 'UTF-8';
31
-
32
-binmode( STDIN, ":encoding($charsetConsole)" );
33
-binmode( STDOUT, ":encoding($charsetConsole)" );
34
-binmode( STDERR, ":encoding($charsetConsole)" );
27
+use CGI qw( -no_xhtml *table ); # //HTML 4.01 Transitional//EN
28
+use Term::Encoding qw(term_encoding);
29
+use open ':std' => ':locale';
35 30
36 31
my $q = new CGI;
37
-$q->charset( $charsetFile );
32
+$q->charset(term_encoding);
38 33
39 34
my $cginame = 'PrintEnv';
40 35
... ...
@@ -42,35 +37,39 @@ printHeader();
42 37
43 38
print $q->start_table( { '-summary' => 'ENV', '-border' => 1 } );
44 39
print $q->Tr( $q->th( [ 'Key', 'Value' ] ) );
45
-foreach ( sort( keys( %ENV ) ) ){
46
- if ( /^(GEOIP_|HTTPS|HTTP_|QUERY_|REMOTE_|REQUEST_|SERVER_(ADDR|NAME|PORT|PROTOCOL))/i ){
47
- print $q->Tr( $q->td( [ $_, $ENV{$_} ] ) );
48
- }
40
+foreach ( sort( keys(%ENV) ) ) {
41
+ if (/^(CONTENT_|GEOIP_|HTTPS|HTTP_|QUERY_|REMOTE_|REQUEST_|SERVER_(ADDR|NAME|PORT|PROTOCOL))/i)
42
+ {
43
+ print $q->Tr( $q->td( [ $_, $ENV{$_} ] ) );
44
+ }
49 45
}
50 46
print $q->end_table();
51 47
48
+if ( my $postdata = $q->param('POSTDATA') ) {
49
+ print $q->h2('POST DATA');
50
+ print $q->blockquote($postdata);
51
+}
52
+
52 53
printFooter();
53 54
54 55
exit;
55 56
56
-sub printHeader
57
-{
58
- print $q->header();
59
- print $q->start_html(
60
- '-title' => $cginame,
61
- '-lang' => 'ja-JP',
62
- '-head' => [
63
- $q->meta( { '-http_equiv' => 'Content-style-type', '-content' => 'text/css' } ),
64
- $q->meta( { '-http_equiv' => 'Content-script-type', '-content' => 'text/javascript' } ),
65
- ],
66
- '-style' => [ { 'src' => '/take.css' }, ],
67
- );
68
- print $q->h1( $cginame );
57
+sub printHeader {
58
+ print $q->header();
59
+ print $q->start_html(
60
+ '-title' => $cginame,
61
+ '-lang' => 'ja-JP',
62
+ '-head' => [
63
+ $q->meta( { '-http_equiv' => 'Content-style-type', '-content' => 'text/css' } ),
64
+ $q->meta( { '-http_equiv' => 'Content-script-type', '-content' => 'text/javascript' } ),
65
+ ],
66
+ '-style' => [ { 'src' => '/take.css' }, ],
67
+ );
68
+ print $q->h1($cginame);
69 69
}
70 70
71
-sub printFooter
72
-{
73
- print $q->end_html . "\n";
71
+sub printFooter {
72
+ print $q->end_html . "\n";
74 73
}
75 74
76 75
# EOF
... ...
@@ -86,13 +85,24 @@ sub printFooter
86 85
use strict;
87 86
use warnings;
88 87
use utf8;
88
+use Term::Encoding qw(term_encoding);
89
+use open ':std' => ':locale';
89 90
90
-print "Content-type: text/plain; charset=UTF-8\n\n";
91
+printf( "Content-type: text/plain; charset=%s\n\n", term_encoding );
91 92
92
-foreach ( sort( keys( %ENV ) ) ){
93
- if ( /^(GEOIP_|HTTPS|HTTP_|QUERY_|REMOTE_|REQUEST_|SERVER_(ADDR|NAME|PORT|PROTOCOL))/i ){
94
- print $_ . "\t" . $ENV{ $_ } . "\n";
95
- }
93
+foreach ( sort( keys(%ENV) ) ) {
94
+ if (/^(CONTENT_|GEOIP_|HTTPS|HTTP_|QUERY_|REMOTE_|REQUEST_|SERVER_(ADDR|NAME|PORT|PROTOCOL))/i)
95
+ {
96
+ print "${_}\t${ENV{$_}}\n";
97
+ }
98
+}
99
+
100
+if ( defined( $ENV{'REQUEST_METHOD'} ) && $ENV{'REQUEST_METHOD'} eq 'POST' ) {
101
+ my $content = '';
102
+ my $limit = 1024 * 1024;
103
+ my $len = $ENV{'CONTENT_LENGTH'} < $limit ? $ENV{'CONTENT_LENGTH'} : $limit;
104
+ read( STDIN, $content, $len );
105
+ print "\nContent:\n${content}\n";
96 106
}
97 107
98 108
# EOF