perllee has asked for the wisdom of the Perl Monks concerning the following question:
----OS:Windows XP,perl5.10,apache 2.2.4
Recentlly,I am reading the book above. in chapter 5, error running the program of file uploads with CGI.pm. Where wrongHThanks.
test.html: <FORM ACTION="http://localhost/cgi-bin/test.cgi" METHOD="POST" ENCTYPE +="multipart/form-data"> <P>Please choose a file to upload: <INPUT TYPE="FILE" NAME="file"> <P>Please enter the name of this file: <INPUT TYPE="TEXT" NAME="filename"> <p><input type="submit" name="Submit" value="Submit Form" /></p> </FORM>
test.cgi: #!c:/Perl/bin/perl use CGI; use Fcntl qw( :DEFAULT :flock ); use constant UPLOAD_DIR => "E:/Apache2"; use constant BUFFER_SIZE => 16_384; use constant MAX_FILE_SIZE => 1_048_576; # Limit each upload to + 1 MB use constant MAX_DIR_SIZE => 100 * 1_048_576; # Limit total uploads +to 100 MB use constant MAX_OPEN_TRIES => 100; $CGI::DISABLE_UPLOADS = 0; $CGI::POST_MAX = MAX_FILE_SIZE; my $q = new CGI; $q->cgi_error and error( $q, "Error transferring file: " . $q->cgi_err +or ); my $file = $q->param( "file" ) || error( $q, "No file receive +d." ); my $filename = $q->param( "filename" ) || error( $q, "No filename ent +ered." ); my $fh = $q->upload( $file ); my $buffer = ""; if ( dir_size( UPLOAD_DIR ) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) { error( $q, "Upload directory is full." ); } # Allow letters, digits, periods, underscores, dashes # Convert anything else to an underscore $filename =~ s/[^\w.-]/_/g; if ( $filename =~ /^(\w[\w.-]*)/ ) { $filename = $1; } else { error( $q, "Invalid file name; files must start with a letter or n +umber." ); } # Open output file, making sure the name is unique until ( sysopen OUTPUT, UPLOAD_DIR . $filename, O_CREAT | O_EXCL ) { $filename =~ s/(\d*)(\.\w+)$/($1||0) + 1 . $2/e; $1 >= MAX_OPEN_TRIES and error( $q, "Unable to save your file." ); } # This is necessary for non-Unix systems; does nothing on Unix binmode $fh; binmode OUTPUT; # Write contents to output file while ( read( $fh, $buffer, BUFFER_SIZE ) ) { print OUTPUT $buffer; } close OUTPUT; sub dir_size { my $dir = shift; my $dir_size = 0; # Loop through files and sum the sizes; doesn't descend down subdi +rs opendir DIR, $dir or die "Unable to open $dir: $!"; while ( readdir DIR ) { $dir_size += -s "$dir/$_"; } return $dir_size; } sub error { my( $q, $reason ) = @_; print $q->header( "text/html" ), $q->start_html( "Error" ), $q->h1( "Error" ), $q->p( "Your upload was not procesed because the following e +rror ", "occured: " ), $q->p( $q->i( $reason ) ), $q->end_html; exit; }
By a perl_CGI Beginner.Thank you very much.
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: <cig programming with perl>,"File Uploads with CGI.pm"_example error
by Corion (Patriarch) on Mar 18, 2010 at 07:49 UTC | |
|
Re: <cig programming with perl>,"File Uploads with CGI.pm"_example error
by Anonymous Monk on Mar 18, 2010 at 07:59 UTC |