[Date Prev][Date Next][Thread Prev][Thread Next]
[Search]
[Date Index]
[Thread Index]
[MacPerl] file uploads
> The only area I am still unsure of tackling is
file uploads. This is purely CGI, not MacPerl, so please excuse my
off-topic
brain picking.
> I want to use this form element to point to a JPEG file on the users drive,
then upload it to a directory on a Unix server.
-----------------------
First of all.... this topic has been covered a couple times in the
"regular" perl newsgroups. If you have generic perl questions, good
resources are the newsgroups:
comp.lang.perl.misc
comp.lang.perl.modules
comp.infosystems.www.authoring.cgi
If you dont already use dejanews to poke around newsgroups, I'd
recommend it as the way to go. goto www.deja.com and sign up for a deja
account.... when you post, your "real" email will be insulated from
spammers that grab addresses from newsgroups.
then there are the generic www resources:
http://www.perl.org
http://www.cpan.org
http://www.boutell.com/openfaq/cgi/
...and many others
all that being said... to address your question. first you need to be
sure you are putting this script is a "safe" place and controlling
access to it somehow. you dont want anyone uploading whatever they want
probably. ;) you can put the interface and scripts under .htaccess
protection, or some other approach.
The actual upload is pretty well documented in the module CGI.pm
documentation. You really can and should let the CGI module handle most
of it. The key thing that took me a while to figure out is that the
filename you upload is BOTH a string variable and an open filehandle. So
when you check the param('fname') it will be the name AND a filehandle
you can write to whatever target you define. Othe rthings to be careful
of are that UNIX filenames dont allow some formats that are common on
mac/win32 systems.... it will throw up if there are spaces for instance.
You have to figure out how you want to deal with that. Checking it
client-side with javascript, or server-side with error traps, etc.
I will paste in a sample of a script I use on one website to handle
something like what you want. You will have to go thru it carefully and
remove my site-specific stuff.
===============
#! /usr/bin/perl -w
=head1 Purpose - UploadImage.pl
This script will handle an upload of an image, and pass control to
BuildGalleryPages
to do all the work of creating the gallery page, index, and homepage
updates. This
script will:
- check for existing image by same name, ask to overwrite.
- check max file size and type
- upload image file to target folder
#
------------------------------------------------------------------------------
=cut
# modules
# -----
use CGI::Carp 'fatalsToBrowser';
use CGI qw( param uploadInfo );
$CGI::POST_MAX= 1024 * 200 ; # set default maximum size of post to
200k
$TempFile::TMPDIRECTORY = './tmp_images' ; # force location of temp
files
# required subroutines
# -----
require "subConfig.pl";
require "subs_4CGI_Status.pl";
#
------------------------------------------------------------------------------
# Input - might be passed in command line from wrapper, or direct from
cgi
my $RedirectTo = param( 'RedirectTo' ) ; # full URL to go to when done
# defaults to admin if undef.
my $UploadedImage = param( 'UploadedImage' ) ; # FH and name of file
my $TargetFolder = param( 'TargetFolder' ) ; # target path under
gallery/
my $OverwriteFlag = param ( 'OverwriteFlag' ); # flag how to handle
duplicate file names
# legal values = 'overwrite'| 'no-overwrite' (default)
#
------------------------------------------------------------------------------
=head1 Output -
- saves uploaded image file and passes control to BuildGalleryPages.
#
------------------------------------------------------------------------------
=head1 Notes -
History - written by Dan Baker, contact at dtbaker61_at_bigfoot.com,
version 1.0 written 11/2/2000
revised //2000
-
=cut
#
------------------------------------------------------------------------------
# Declarations
#
------------------------------------------------------------------------------
# dummies
# -----
my $tempString = "" ;
my $tempInt = 0 ;
my $tempFloat = 0.0 ;
my $tempList = () ;
# local vars
# -----
my $StatusMsg = "";
#
3456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-
# ########################### Start Main Executable code
#######################
#
##############################################################################
# fire up status logs
&New_Status( $cCgiStatusFile , 5 );
$StatusMsg = scalar(localtime)." Beginning UploadImage Process --------
\n\n" ;
print DEBUG_LOG $StatusMsg ;
&Append_Status ( $cCgiStatusFile , "<P>$StatusMsg " );
#
------------------------------------------------------------------------------
# check input
unless ( $OverwriteFlag ) { $OverwriteFlag = 'no-overwrite' }
unless ( $UploadedImage ) {
&Warning_Status( $cCgiStatusFile , "You did not enter a path for a
file to ".
"upload. Use your browser \"Back\" button and enter a filepath to the
image ".
"on your local PC that you want to upload." ) ;
exit ;
}
# check to make sure it is the right type
# -----
$tempString = ${uploadInfo($UploadedImage)}{'Content-Type'} ; #
deref the hash of info
#
unless ( $tempString ) {
&Warning_Status( $cCgiStatusFile ,
"Path entered for file was invalid...\n".
"Try using the browse button to select a file.\n".
"\nUse the Browser \"Back\" button to return to the ".
"upload management page.\n" ) ;
exit ;
}
#
if (( $tempString ne 'image/jpeg' )and
( $tempString ne 'image/pjpeg' )and
( $tempString ne 'image/gif' )
) {
&Warning_Status( $cCgiStatusFile ,
"Cannot upload file with Content-Type = $tempString , ".
"it MUST be either .jpg or .gif file!".
"\nPlease use the browser \"Back\" button, and select ".
"an image file.\n" );
exit ;
}
# $cDEBUG=1; print DEBUG_LOG "type= $tempString "; $cDEBUG=0;
# save the original local file name/handle to use later
my $UploadFH = $UploadedImage ;
# figure out filename to save it as, and make sure it is "legal"
# -----
$UploadedImage =~ s/.*[\\|\/](.+)$/$1/ ; # grab end of path passed in
$UploadedImage =~ s/\s/_/g ; # convert spaces to _
# build relative path to new image target
# -----
my $ImagePath = $cAdminCgi2Gallery ; # path to top of gallery
if ( $TargetFolder ) { # if sub-gallery
$ImagePath = "$ImagePath\/$TargetFolder" ; # add sub-gallery path
}
$ImagePath = "$ImagePath\/$UploadedImage" ; # add filename
# check to see if we will overwrite an existing file on the server
# -----
if ( -f $ImagePath and ( $OverwriteFlag eq 'no-overwrite' ))
{
&Warning_Status( $cCgiStatusFile ,
"File $ImagePath already exists on server, \n".
"you currently have set preferences not to overwrite existing
files. \n".
"\nUse the browser \"Back\" button to return to the upload page
\n".
"where you can either set to overwrite, or pick a different image.
\n" );
exit ;
}
#
------------------------------------------------------------------------------
#
# write the file from open filehandle
# -----
&Append_Status( $cCgiStatusFile ,
"<P> Uploading $UploadFH to $ImagePath \n" );
&WriteUploadFile( $UploadFH , $ImagePath ) ;
#
------------------------------------------------------------------------------
# done saving image... pull in code to save ImageInfo and build html
pages
# set a few more params that will be needed
# -----
param( 'SelectionMethod' , 'PassedIn' );
param( 'TopPaths' , $ImagePath );
param( 'SkipSizing' , 'false' );
# pull in the code to do the work
# -----
$StatusMsg = scalar(localtime)." done uploading file $ImagePath , ".
"beginning SaveImageInfo... \n\n" ;
print DEBUG_LOG $StatusMsg ;
&Append_Status( $cCgiStatusFile , "<P> $StatusMsg" );
#
require "SaveImageInfo.pl" ; # pull the code in-line here
#
------------------------------------------------------------------------------
# ###################################### done
################################
1;
#
##############################################################################
# local subs
#
##############################################################################
sub WriteUploadFile { my ( $FromFH , $ToPath ) = @_ ;
# we are using this sub because we dont trust CGI:: to check size
# local vars
my $bytesread ;
my $buffer = "";
my $flen = 0 ;
open ( TARGETFILE , ">$ToPath" ) ;
binmode( TARGETFILE );
binmode( $FromFH );
$flen = 0 ;
while ( $bytesread = read( $FromFH , $buffer , 1024 ) ) {
print TARGETFILE $buffer ;
$flen += 1024 ;
if ( $flen > $CGI::POST_MAX ) { # check size here since
# we cant count on CGI to do it
print "Content-type: text/plain \n\n".
"FATAL ERROR - \n\n".
"The file $FromFH \nthat you attempted to upload ".
"is too big. \nOnly $CGI::POST_MAX kbytes are ".
"allowed. \n\n".
"Please use your browser \"Back\" button and ".
"resample, crop, or select a smaller file...\n";
close $FromFH ;
close TARGETFILE ;
unlink $ToPath or die "could not delete working file because $!" ;
exit;
}
}
close $FromFH ;
close TARGETFILE ;
chmod 0666, "$ToPath" ;
unless (-f $ToPath ) { # something might have gone wrong during the
save
die "FATAL ERROR - could not upload >$FromFH< to >$ToPath< because $!
\n";
}
1;}
#
##############################################################################
1; # ------------------------- end of file
-------------------------------------
# ===== Want to unsubscribe from this list?
# ===== Send mail with body "unsubscribe" to macperl-request@macperl.org