CGI Upload Code

[David Gilden]

Holiday Greetings,
I copied this from a CGI web site, and while it does work,
I was wondering what folks with more experience in PERL thought of 
this code.
Thanks for any comments,
Dave Gilden


#!/usr/bin/perl -w

use CGI qw/:standard/;
use CGI;
use Fcntl qw( :DEFAULT :flock );
use CGI::Carp qw(fatalsToBrowser);
use strict;

# Upload Code
use constant UPLOAD_DIR     => "/home/sites/site01/web/private/mydata/";
use constant BUFFER_SIZE    => 16_384;
use constant MAX_FILE_SIZE  => 2 * 1_048_576;   #Limit each upload to 2 MB
use constant MAX_DIR_SIZE   => 10 * 1_048_576; # Limit total uploads to 10 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_error );

my $action = $q->param( "action" );
    
    if  ($action =~ /Update/) {
        print redirect("./import_clean_csv.php");
        exit;
    };
        
    if  ($action =~ /Clean/) {
    my @filesToRemove;  
     
    chdir UPLOAD_DIR or die "Couldn't chdir to afm_data directory: $!";
    
    #my @filesToRemove  =  map  {$_ =~ /^(\w[\w.-]*)/} <*>;
    
    opendir(DR,"./");
    @filesToRemove  =  grep  {$_ =~ /^(\w[\w.-]*)/} readdir DR;
    closedir DR;


print $HTML_HEADER;
print '<div align="center">';

    foreach my $fr (@filesToRemove) {
    
    print  "Deleted $fr<br>\n";
    unlink($fr)  or die "Couldn't Delete $fr $!";
    }

print <<HTML_OUT;
<p class="top-header">Your Done close this window! 
<form><input type="button" onclick="self.close()" value="Close  
Window"></form></p>
</div>
HTML_OUT
print end_html;
exit;
    };


    if  ($action =~ /Upload/) {

my $file = $q->param( "file" ) || error( $q, "No file received." );

# my $filename  = $q->param( "filename" ) || error( $q, "No filename entered." 
);
my $fh        = $q->upload( "file" );
my $buffer    = "";

if ( dir_size( UPLOAD_DIR ) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) {
    error( $q, "Upload directory is full." );
}


        # Open output file, making sure the name is unique
        until ( sysopen OUTPUT, UPLOAD_DIR . "/$file", O_CREAT | O_RDWR | 
O_EXCL ) {
        #   $file =~ 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;

------snip-------


Cool music.....From Guineé comes this CD of kora fusion, electronica  
[ Audition Mp3s at the URL below ]
<http://www.coraconnection.com/pages/other_cds.html#sabolan>

--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>