何故か自宅サーバーがFTPで繋がらないことが多く、でもちょっとした事情によりファイルのアップロードをしたいときに困ったので。
#!/usr/bin/perl -T use strict; use warnings; use CGI; use File::Basename; use HTTP::Date; my $script_name = basename $0; my $cgi = CGI->new; $cgi->charset("utf-8"); print $cgi->header(-charset => 'utf-8'); print $cgi->start_html( -title => 'upload', -encoding => 'utf-8', ); print q|<form method="post" enctype="multipart/form-data"> <input type="file" name="upload_file" /> <input type="submit" value="うpするぉ" /> </form> |; my $method = $ENV{'REQUEST_METHOD'}; if (defined $method && $method eq 'POST') { my $fh = $cgi->upload('upload_file') or die(qq(Invalid file handle returned.)); my $name = $1 if $cgi->uploadInfo($fh)->{'Content-Disposition'} =~ /filename="(.*)"/; $name = $1 if $name =~ /.*\\(.*)/; print "Upload!! : $name<br />\n"; open OUT, '>', $name or print $!; binmode OUT; my $buf; while (read $fh, $buf, 1024) { print OUT $buf; } close(OUT); close($fh); } print "<table>\n"; print " <th>name</th><th>size</th><th>time</th>\n"; opendir DIR, '.'; for (readdir DIR) { next if m|^\.|; next if $_ eq $script_name; my $name = $_; my $size = -s $name; my $time = HTTP::Date::time2iso ((stat $name)[9]); print qq| <tr> <td><a href="$name">$name</a></td> <td align="right">$size</td> <td>$time</td> </tr> |; } close(DIR); print "</table>"; print $cgi->end_html, "\n";