#!/usr/bin/perl -w use CGI::Carp qw(fatalsToBrowser); use warnings; use CGI qw/:standard/; use POSIX; use DB_File; my %upload; my $upload = "imagegallery.db"; tie %upload, "DB_File", "$upload", O_CREAT|O_RDWR, 0644, $DB_BTREE or die "Cannot open file 'upload': $!\n"; my $mode = 0755; print header, start_html('upload form'); print "Upload formats allowed: jpg, gif, bmp, png, tiff
"; print start_form( -method => 'post', -enctype => 'multipart/form-data', -action=> '' ), table({-border=>1, -width=>600, -bgcolor=>'D3D3D3', cellpadding=>0, cellspacing=>0}, Tr( td({bgcolor => '000080'}, '
IMAGE 1
'), td({bgcolor => '000080'}, '
IMAGE 2
'), Tr( td("Title: "), td("Title: "), Tr( td( textfield( -name => 'title1', -size => 50, -maxlength => 80 ), td( textfield( -name => 'title2', -size => 50, -maxlength => 80 ), Tr( td("Description: "), td("Description: "), Tr( td( textfield( -name => 'desc1', -size => 50, -maxlength => 80 ), td( textfield( -name => 'desc2', -size => 50, -maxlength => 80 ), Tr( td("Upload: "), td("Upload: "), Tr( td( filefield( -name => 'upload1', -size => 50, -maxlength => 80 ), td( filefield( -name => 'upload2', -size => 50, -maxlength => 80 ), Tr( td({bgcolor => '000080'}, '
IMAGE 3
'), td({bgcolor => '000080'}, '
IMAGE 4
'), Tr( td("Title: "), td("Title: "), Tr( td( textfield( -name => 'title3', -size => 50, -maxlength => 80 ), td( textfield( -name => 'title4', -size => 50, -maxlength => 80 ), Tr( td("Description: "), td("Description: "), Tr( td( textfield( -name => 'desc3', -size => 50, -maxlength => 80 ), td( textfield( -name => 'desc4', -size => 50, -maxlength => 80 ), Tr( td("Upload: "), td("Upload: "), Tr( td( filefield( -name => 'upload3', -size => 50, -maxlength => 80 ), td( filefield( -name => 'upload4', -size => 50, -maxlength => 80 ), Tr( td(), td( submit( 'button', 'submit' ), ) ) ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), ), end_form(), hr; if ( param('upload1') ) { my $num = 1; &dirty_work($num); } if ( param('upload2') ) { my $num = 2; &dirty_work($num); } if ( param('upload3') ) { my $num = 3; &dirty_work($num); } if ( param('upload4') ) { my $num = 4; &dirty_work($num); } sub dirty_work { my $num = shift; # take form data my $remotefile = param("upload$num"); # make new variable to prevent overwriting of form data my $filename = $remotefile; my $title = param("title$num"); $title =~ s/&/&\#38/g; my $desc = param("desc$num"); $desc =~ s/&/&\#38/g; # remove all directories in the file name path $filename =~ s/^.*[\\\/]//; # full file path to upload directory (must include filename) my $localfile = "/home/sulfericacid/public_html/playground/upload/files/$filename"; # full url to upload directory (cannot include filename or an end slash /) my $url = "http://sulfericacid.perlmonk.org/playground/upload/files"; my $type = uploadInfo($remotefile)->{'Content-Type'}; unless ( $type eq 'image/pjpeg' || $type eq 'image/gif' || $type eq 'image/bmp') { print "Wrong! This is not a supported file type."; exit; } # open a new file and transfer bit by bit from what's in the buffer open( SAVED, ">>$localfile" ); # || die $!; while ( $bytesread = read( $remotefile, $buffer, 1024 ) ) { print SAVED $buffer; } close SAVED; chmod $mode, "$localfile"; # or die "can't chmod: $!"; # requi since module was not preinstalled on server use lib "/home/sulfericacid/public_html/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); my $combo = join("::", $filename, $title, $desc, $w, $h); $upload{localtime()} = "$combo"; sleep 2; print "
"; print "File:
"; print qq(File was uploaded to $url\/$filename
); print qq(<p style =\"background:url\($url\/$filename\)\;width:$w\;height:$h\;\">); print "
"; } #### #!/usr/bin/perl -w use warnings; use CGI qw/:standard/; use CGI::Carp qw(fatalsToBrowser); use POSIX; use DB_File; my %upload; my $upload = "imagegallery.db"; # full file path to image directory my $imagedir = "http://sulfericacid.perlmonk.org/playground/upload/files/"; tie %upload, "DB_File", "$upload", O_CREAT | O_RDWR, 0644, $DB_BTREE or die "Cannot open file 'upload': $!\n"; print header, start_html('My Image Gallery'); my $page = url_param('page'); $page ||= 1; # if no url_param exists, make it 1 my $first = ($page - 1) * 20; my $last = $first + 19; print "\n"; my $counter = 0; for (grep defined($_), (reverse keys %upload)[$first .. $last]) { my ( $filename, $title, $desc, $width, $height ) = split ( /::/, $upload{$_} ); print " " unless ( $counter % 5 ); $title =~ s/(\S{11})/$1 /g; $desc =~ s/(\S{11})/$1 /g; print qq(); unless ( ++$counter % 5 ) { print "\n"; } } print "
), qq[], qq[
]; $filename =~ s/(\S{11})/$1 /g; print qq(Filename:$filename
), qq(Title:$title
), qq(Desc:$desc
), qq(Dimens: $width x $height
), qq(
"; my @keys = sort keys %upload; my $group = 0; while (my @group = splice(@keys, 0, 20)) { $group++; my $url = "http://sulfericacid.perlmonk.org/playground/upload/newupload.pl"; print qq(Page: $group|\n); }