#!/usr/bin/perl -w

use warnings;
use CGI qw/:standard/;

use POSIX;

my $mode = 0755;

print header, start_html('upload form');

print "Upload formats allowed: jpg, gif, bmp.<br>";

print start_form(
    -method  => 'post',
    -enctype => 'multipart/form-data'
  ),
  table(
    Tr(
        td("File: "),
        td(
            filefield(
                -name      => 'upload',
                -size      => 50,
                -maxlength => 80
            ),
        ),
    ),
    Tr( td(), td( submit( 'button', 'submit' ), ) )
  ),
  end_form(), hr;

print "By clicking Submit you are agreeing that any legal discreptanci
+es involved with the images you upload";
print " are not the responsibility of the designer of this script or t
+he webhost.  You are agreeing these";
print " pictures are not copyright material, do not contain viruses an
+d does not promote sexual or violent";
print " activities.  It is a legal signature of awknowledgement once y
+ou click the Submit button.<br><br>";
if ( param() ) {

    # take form data
    my $remotefile = param('upload');

    # make new variable to prevent overwriting of form data
    my $filename = $remotefile;

    # remove all directories in the file name path
    $filename =~ s/^.*[\\\/]//;

    # full file path to upload directory (must include filename)
    my $localfile = "";

    # full url to upload directory (cannot include filename or an end 
+slash /)
    my $url = "";

    my $type = uploadInfo($remotefile)->{'Content-Type'};
    unless ( $type eq 'image/pjpeg' || $type eq 'image/gif' || $type e
+q 'image/bmp') {
        print "Wrong!  This is not a supported file type.";
        exit;
    }
# print "type: $type <br><br>";

    # open a new file and transfer bit by bit from what's in the buffe
+r
    open( SAVED, ">>$localfile" );    # || die $!;
    while ( $bytesread = read( $remotefile, $buffer, 1024 ) ) {
        print SAVED $buffer;
    }
    close SAVED;

    chmod $mode, "$localfile";        # or die "can't chmod: $!";
    print "-----------------------------<br>";
    print
qq(File was uploaded to <a href="$url\/$filename">$url\/$filename</a>)
+;

    # required since module was not preinstalled on server
    # use lib "";
    use Image::Info qw(image_info dim);
  
    # assigning info to a filename (better be an image)
    my $info =
      image_info("$localfile");
   # if for any reason we can't open the file, this error trap should 
+pick it up
    if ( my $error = $info->{error} ) {
        #die "Can't parse image info: $error\n";
    }
    # unommit next line if you want to use/post the image's color
    #my $color = $info->{color_type};

    # declaring the width and heighth of your image
    my ( $w, $h ) = dim($info);

    print "<br><br><br>";
    print "Image code:<br>";
    print
qq(&lt;p style =\"background:url\($url\/$filename\)\;width:$w\;height:
+$h\;\"&gt;);
print "<br>-----------------------------<br>";
}