use strict;
use CGI;
use Fcntl qw( :DEFAULT :flock );
use File::Basename;

use constant UPLOAD_DIR     => '/some/dir';
use constant TYPES          => qw( .txt .jpg );
use constant BUFFER_SIZE    => 16_384;
use constant MAX_FILE_SIZE  => 1_048_576;
use constant MAX_DIR_SIZE   => 100 * 1_048_576;
use constant MAX_OPEN_TRIES => 100;

$CGI::POST_MAX = MAX_FILE_SIZE;

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 error( $q, "Unable to open $dir: $!" );

    while ( readdir DIR ) {
        $dir_size += -s "$dir/$_";
    }
    return $dir_size;
}

{
    my $q      = new CGI;
    my $os     = $q->param('os');
    my $file   = $q->param('file');
    my $title  = $q->param('title');
    my $fh     = $q->upload('file');
    my $buffer = '';

    if ( dir_size(UPLOAD_DIR) + $ENV{CONTENT_LENGTH} > MAX_DIR_SIZE ) 
+{
        error( $q, 'Upload directory is full.' );
    }
    elsif ( $file ne '' ) {
        fileparse_set_fstype($os);

        my ( $base, $path, $ext ) = fileparse( $file, qr/\..*/ );
        my $num_types = scalar TYPES;
        my $maybe     = 0;

        foreach my $type (TYPES) {
            $maybe++ if $type !~ /$ext/i;
        }

        error( $q,
            'Invalid file type. Please upload only '
              . join ( ' ', TYPES )
              . ' files.' )
          unless $maybe < $num_types;

        my $filename = $base . $ext;
        $filename =~ s/[^\w.-]/_/g;

        if ( $filename =~ /^(\w[\w.-]*)/ ) {
            $filename = $1;
        }
        else {
            error( $q,
                'Invalid file name. Files must start with a letter or 
+number.'
            );
        }

        # Open output file, making sure the name is unique.
        until (
            sysopen OUTPUT,
            UPLOAD_DIR . "/$filename",
            O_RDWR | O_EXCL | O_CREAT
          )
        {
            $filename =~ s/(\d*)($ext)$/($1||0) + 1 . $2/e;
            $1 >= MAX_OPEN_TRIES and error( $q, 'Unable to save your f
+ile.' );
        }

        # This is necessary for non-Unix systems; does nothing on Unix
+.
        binmode $fh;
        binmode OUTPUT;

        while ( read( $fh, $buffer, BUFFER_SIZE ) ) {
            print OUTPUT $buffer;
        }
        close OUTPUT;

        print $q->header, $q->start_html( -title => 'Successful Upload
+!', ),
          $q->h1('Your file was successfully uploaded!'), $q->end_html
+;
    }
    else {
        error( $q, 'You must specify a file to upload.' );
    }
}
[download]