個人的な覚え書き。
ファイル送信フォームを使用するクライアントが IE だったら、送られてきたファイル名をそのまま使うとキケンだよ。送信元のシステムにおけるフルパスが送信されます。
必ず、File::Basename モジュールの fileparse を通すか、正規表現等でファイル名だけを取り出す処理を追加しましょう。
#!C:/Program Files/Xampp/perl/bin/perl.exe
use strict;
use warnings;
use CGI;
use File::Basename;
my $q = CGI->new;
my $upload_FH = $q->upload('file');
fileparse_set_fstype('MSDOS');
my $filename = fileparse($upload_FH);
print $q->header(
-type => 'text/plain',
-charset => 'utf-8',
);
print q/$q->upload('file') :/,
"\n\t$upload_FH\n\n";
print q/fileparse($q->upload('file')) :/,
"\n\t$filename\n";
Win IE 6 からこの CGI に送信すると、以下のようになります。
$q->upload('file') :
C:\Documents and Settings\CL\デスクトップ\test.lzh
fileparse($q->upload('file')) :
test.lzh
(2007-11.15 16.47追記)
fileparse_set_fstype('MSDOS'); を挿入すべきでした。ソースには追加しておきました。作例はWindowsのActivePerlで動いているのでたまたま問題ないんですけれども、実行環境に依存するのです。
もっと正確にするには、IEのときだけ実行するコードにしましょう。
#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use File::Basename;
my $q = CGI->new();
if ( _checkWinIE() ) {
fileparse_set_fstype('MSDOS');
}
my $file = q();
if ($q->upload('file') ) {
$file = fileparse($q->upload('file') );
}
print $q->header( -type => 'text/plain' );
print "$file \n";
exit;
sub _checkWinIE {
use HTTP::BrowserDetect;
my $ua = HTTP::BrowserDetect
->new($ENV{'HTTP_USER_AGENT'});
if ( ( $ua->browser_string() eq 'MSIE')
&& ( $ua->os_string() =~ m/^Win/ ) ) {
return 1;
}
return;
}













