Perl script for file upload

Question

I am trying to write a script in Perl that will allow the user to upload a file. At the moment, it says that it is working, but it does not actually upload the file!

Her

Answer 1

CGI, besides lots of documentation, also comes with a lot of examples, see http://search.cpan.org/dist/CGI/MANIFEST

So combined with that knowledge, you can write

#!/usr/bin/perl --
use constant DEBUG => !!( 0 || $ENV{PERL_DEBUG_MYAPPNAME} );
use CGI;
use CGI::Carp qw( fatalsToBrowser );

# to avoid those pesky 500 errors
BEGIN {
    CGI::Carp::set_message(
        sub {
            print "
Oooh I got an error, thats not good :)
\n";
            if (DEBUG) {
                print '
', CGI->escapeHTML(@_), '
';
            }
        }
    );
} ## end BEGIN


use strict;
use warnings;
use Data::Dumper ();
use File::Copy qw' copy ';

Main( @ARGV );
exit( 0 );

sub Main {

#~     return DebugCGI(); # generic, env.cgi
    return SaveUploadsTo(
        CGI->new,
        [qw' file otheruploadfile andAnother '],
        '/destination/dir/where/uploads/end/up', 
    );
} ## end sub Main


sub SaveUploadsTo {
    my( $cgi,  $uploadFields , $destDir ) = @_;
    chdir $destDir
      or die "Cannot chdir to upload destination directory: $!\n";
    print $cgi->header;
    for my $field ( @{ $uploadFields } ){
        my $filename = $cgi->param( $field );
        my $tmpfilename = $cgi->tmpFileName( $filename );
        $filename = WashFilename( $filename ) ;

        my $destFile = File::Spec->catfile( $destDir, $filename );

        copy( $tmpfilename, $destFile )
          or die "Copy to ( $destFile ) failed: (( $! ))(( $^E ))";

        print "
Sucessfully uploaded  ",
            CGI->escapeHTML( $filename  ),
            " thanks
\n";
    }
    print "
done processing uploads
\n";
} ## end sub SaveUploadsTo

sub DebugCGI {
    my $cgi = CGI->new;
    print $cgi->header();    # Write HTTP header
    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 WashFilename {
    use File::Basename;
    my $basename = basename( shift );
    # untainted , only use a-z A-Z 0-9 and dot
    $basename = join '', $basename =~ m/([.a-zA-Z0-9])/g;
    # basename is now, hopefully, 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 DD { scalar Data::Dumper->new( \@_ )->Indent(1)->Useqq(1)->Dump; }

Your code shrinks when you switch to Dancer/Catalyst/Mojolicious