upload script in perl

忘れたころに必要になるアップロードスクリプト。

#!/usr/bin/perl

use strict;
use warnings;
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use IO::File;

my $cgi = CGI->new;

print $cgi->header();
print $cgi->start_html("File Upload Example");
print $cgi->start_multipart_form();
print $cgi->filefield('filename');
print $cgi->submit();
print $cgi->endform();

if (my $file = $cgi->param('filename')) {
    my $fh = IO::File->new("> binary");
    while (<$file>) { print $fh $_; }
    $fh->close;

    print $cgi->hr();
    print $cgi->start_pre();
    my $fh = IO::File->new("< binary");
    while (<$fh>) { print }
    $fh->close;
    print $cgi->end_pre();
    print $cgi->hr();
    close $file;
}