#!/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>"; }

In reply to Image uploader by sulfericacid

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.