| 1 |
#!/usr/bin/perl |
| 2 |
use strict; |
| 3 |
use Encode; |
| 4 |
use encoding qw(iso-2022-jp); |
| 5 |
use CGI qw(param); |
| 6 |
|
| 7 |
sub token ($) { |
| 8 |
my $s = shift; |
| 9 |
$s =~ s/[^0-9A-Za-z_+.-]//g; |
| 10 |
$s; |
| 11 |
} |
| 12 |
sub escape ($) { |
| 13 |
my $s = shift; |
| 14 |
$s =~ s/&/&/g; |
| 15 |
$s =~ s/</</g; |
| 16 |
$s; |
| 17 |
} |
| 18 |
sub ascii_html ($) { |
| 19 |
my $s = shift; |
| 20 |
$s =~ s!([^\x20-\x7E])!sprintf '<code>%02X</code>', ord $1!ge; |
| 21 |
$s; |
| 22 |
} |
| 23 |
sub check ($$$) { |
| 24 |
my ($name, $label, $defval) = @_; |
| 25 |
qq(<label><input type="checkbox" name="@{[escape $name]}" @{[$defval eq 'on' ? 'checked="checked"' : '']} />@{[escape $label]}</label>); |
| 26 |
} |
| 27 |
sub select_options ($$$) { |
| 28 |
my ($name, $vals, $defval) = @_; |
| 29 |
my $r = qq(<select name="@{[escape $name]}">); |
| 30 |
for (@$vals) { |
| 31 |
$r .= qq(<option value="@{[escape $_]}">@{[escape $_]}</option>); |
| 32 |
} |
| 33 |
$r .= qq(</select>); |
| 34 |
$r; |
| 35 |
} |
| 36 |
|
| 37 |
my $filename = q(ファイル×1); |
| 38 |
|
| 39 |
my $charset = token param ('charset') || 'iso-8859-1'; |
| 40 |
my $charset_specify = param ('no-charset') ? 0 : 1; |
| 41 |
my $disposition = token param ('disposition') || 'inline'; |
| 42 |
|
| 43 |
my $encode = param ('encode'); |
| 44 |
if ($encode eq 'bare') { |
| 45 |
$filename = 'filename="' . encode ($charset, $filename) . '"'; |
| 46 |
} else { |
| 47 |
$filename = encode ($charset, $filename); |
| 48 |
$filename =~ s/([^0-9A-Za-z_+.-])/sprintf '%%%02X', ord $1/ge; |
| 49 |
$filename = 'filename*=' . $filename; |
| 50 |
} |
| 51 |
|
| 52 |
print <<EOH; |
| 53 |
Content-Type: text/html@{[$charset_specify?qq(; charset=$charset):'']} |
| 54 |
Content-Disposition: $disposition; $filename |
| 55 |
|
| 56 |
<!DOCTYPE html SYSTEM> |
| 57 |
<title>Example file</title> |
| 58 |
<style type="text/css" media="all"> |
| 59 |
code { color: gray; text-decoration: underline } |
| 60 |
</style> |
| 61 |
|
| 62 |
File content |
| 63 |
|
| 64 |
<pre> |
| 65 |
Content-Type: text/html@{[$charset?escape qq(; charset=$charset):'']} |
| 66 |
Content-Disposition: @{[escape $disposition]}; @{[ascii_html escape $filename]} |
| 67 |
</pre> |
| 68 |
|
| 69 |
|
| 70 |
<form action="@{[escape $ENV{SCRIPT_NAME}]}" method="post"> |
| 71 |
<dl> |
| 72 |
<dl>Content Disposition type |
| 73 |
<dt>@{[select_options 'disposition', [qw/inline attachment form-data file x-unknown-value/], $disposition]} |
| 74 |
<dt>Charset |
| 75 |
<dd>@{[select_options 'charset', [qw/iso-8859-1 us-ascii utf-8 iso-2022-jp euc-jp shift_jis/], $charset]}</dd> |
| 76 |
<dd>@{[check 'no-charset', 'Don\'t use charset parameter', not $charset_specify]} |
| 77 |
<dt>Encoding |
| 78 |
<dd>@{[select_options 'encode', [qw/bare 2231 /], $encode]} |
| 79 |
<dt><input type="submit" /> |
| 80 |
</dl> |
| 81 |
</form> |
| 82 |
EOH |
| 83 |
|
Parent Directory
| 
Revision Log