#!/usr/bin/perl --
##
##
##
## perltidy -olq -csc -csci=10 -cscl="sub : BEGIN END if while for " -otr -opr -ce -nibc -i=4 -pt=0 "-nsak=*"
##
#!/usr/bin/perl --
use CGI::Carp qw( fatalsToBrowser );
use strict;
use warnings;
use CGI ();
main( @ARGV );
exit( 0 );
sub main {
# return DebugCGI();
$CGI::POST_MAX = 1024 * 5000;
my $upload_dir = 'goner';
my $query = CGI->new;
my( $headers, $body ) = SaveUploadsTo( $query, $upload_dir );
print $headers, $body;
} ## end sub main
sub SaveUploadsTo {
my( $query, $upload_dir ) = @_;
return $query->header, PrintPage( $query )
if not $query->first_param( "filecsv" );
my $filename = WashFilename( $query->first_param( "filecsv" ) );
## imaginary alternative
# my( $filename, $error ) = WashFilename( $query->first_param( "filecsv" ) );
# $error and return $query->header, ErrorPage( $query, $error );
my $tmpfilename = $query->tmpFileName( $query->first_param( "filecsv" ) );
$tmpfilename
or return $query->header, ErrorPage( $query, "No file uploaded" );
$filename = "$upload_dir/$filename";
require File::Copy;
File::Copy::copy( $tmpfilename, $filename )
or die "Copy to ( $filename ) failed: (( $! ))(( $^E ))";
return $query->header, ThanksPage( $query );
} ## end sub SaveUploadsTo
sub ErrorPage {
my( $query, $message ) = @_;
return qq{
Error
$message
}
} ## end sub ErrorPage
sub CGI::first_param { return my( $first ) = CGI::multi_param( @_ ); }
sub DebugCGI {
my( $cgi ) = @_;
$cgi ||= CGI->new;
binmode STDOUT, ':encoding(UTF-8)';
$cgi->charset( 'UTF-8' );
print $cgi->header( -charset => 'UTF-8' );
print $cgi->start_html,
$cgi->b( rand time, ' ', scalar gmtime ),
'| ',
$cgi->Dump,
' | ',
'',
$cgi->escapeHTML( DD( $cgi ) ),
' |
',
CGI->new( \%ENV )->Dump,
$cgi->end_html;
} ## end sub DebugCGI
sub DD {
require Data::Dumper;
return scalar Data::Dumper->new( \@_ )->Indent( 1 )->Useqq( 1 )->Dump;
}
sub WashFilename {
use File::Basename;
my $basename = basename( shift );
# untainted , only use a-z A-Z 0-9 and dot and dash
$basename = join '', $basename =~ m/([\-.a-zA-Z0-9])/g;
# basename is now, hop0efully, file.ext
## so to ensure uniqueness, we adulterate it :)
my $id = $$ . '-' . time;
my( $file, $ext ) = split /\./, $basename, 2;
return join '.', grep defined, $file, $id, $ext;
} ## end sub WashFilename
sub ThanksPage {
my( $query ) = @_;
q{
Thanks!
Thanks for uploading your file!
}
} ## end sub ThanksPage
sub MaintenancePage {
q{
MAINTENANCE PAGE
};
} ## end sub MaintenancePage
sub PrintPage {
my( $q ) = @_;
<<'__HTML__';