John W Moon Systems Project Analyst
Enterprise Information Technology Services (EITS) Department of Management Services 4030 Esplanade Way, Suite 260G Tallahassee, Fl 32399-0950 Office: (850)922-7511 Email: [EMAIL PROTECTED] Please note: Florida has a very broad public records law. Most written communications to or from state officials regarding state business are public records available to the public and media upon request. Your e-mail communications may therefore be subject to public disclosure. -----Original Message----- From: Anish Kumar K. [mailto:[EMAIL PROTECTED] Sent: Thursday, April 06, 2006 5:45 AM To: beginners@perl.org Subject: Can any one tell me a better way to upload a file from the HTML form to a location in my home directorrt. I tried many ways, Though I am seeing the file. the SIZE IS 0. I tried out these ways First One ============= my $upload_file= $q->param('upload_file'); # This is the description file which is being uploaded if ($upload_file) { my $outfile="/home/anish/testing.doc"; open(OUTFILE,">$outfile") or warn "can't write $outfile: $!"; print OUTFILE <$upload_file>; close(OUTFILE); } ================ Second Method ============ my $upload_file= $q->param('upload_file'); # This is the description file which is being uploaded my $outfile="/home/anish/testing.doc"; my $bytes_read=0; my $size=''; my $buff=''; my $start_time; my $time_took; if (!open(WFD,">$outfile")) { print "<BR> Cannot Write the file "; exit(-2); } $start_time=time(); while ($bytes_read=read($upload_file,$buff,2096)) { $size += $bytes_read; binmode WFD; print WFD $buff; } close(WFD); if ((stat $outfile)[7] <= 0) { unlink($outfile); print "Could not upload file: $upload_file"; return; } else { $time_took=time()-$start_time; print "The Time Took is $time_took and the size is $size"; } ============ Here is part of what I do... This is pretty much from the docs... Hope this helps get you started.. jwm #------------------------------------- sub ShowRequest { unless ($dbh) { $dbh=&MyConnect unless ($dbh); } $period = substr(&MyCurrent_Period($dbh),3); # format to "Mon-YYYY" # # build list of files to upload # %files = (); &GetFiles; # # build "Put" select list # my (@put_list, %put_hash); @put_list = ('None'); $put_hash{'None'} = ''; my $title; foreach my $nm (keys %files) { push @put_list, $nm; # key of r_import_files $title = $files{$nm}{AKA}; $put_hash{$nm} = sprintf('%35s - %s', $title . '.' x (35 - length($title)) , $files{$nm}{CREATED}); } my $MyVerify = &IncludeScript('upload.js'); &MyStd_Caption($q,'TechDirect UpLoad Services',$MyVerify,$q->br('Data UpLoads'), 'Browse for file to ' . $q->i('Get') . $q->br('and label with required '. $q->i('Put') . ' name.'), $period); print $q->start_multipart_form(-name=>'upload', -onSubmit=>'return MyVerify(this);'), $q->p({-align=>'CENTER'}, $q->checkbox(-name=>'REMOVE', -label=>'Remove all existing files before Upload ?')), $q->p( $q->b('Get: '), $q->filefield({-name=>'FILE',-size=>50})), $q->p( $q->table( $q->Tr( $q->td({-class=>'fix_xsmall'},[' ', 'Service Items...................... - Last Upload'])), $q->Tr( $q->td($q->b('Put: ')), $q->td( $q->popup_menu(-name=>'FILE_KNOWN_AS', -values=>[EMAIL PROTECTED], -default=>'None', -labels=>\%put_hash, -class=>'fix_xsmall'))))), $q->p({-align=>'CENTER'}, $q->submit({-label=>'Send'})), # $q->submit({-label=>'Send', -onSubmit=>'return MyVerify(this);'})), $q->p( $q->font({-color=>'RED'}, 'Status :'), $q->u($q->font({-color=>'BLUE'}, $status))), $q->hidden(-name=>'UPLOAD',-value=>'YES'), $q->end_form, $q->end_html; } #------------------------------------- # Process request for file Upload and/or remove existing files # sub GetData { $status = ''; $dbh=&MyConnect; %files = (); &GetFiles; # get the list of available files my $removed = 0; if ($REQUEST{REMOVE}) { foreach (keys %files) { my ($cat, $file_nm) = split /=/, $_; $removed += unlink "$files{$_}{PATH}/$file_nm" if -e "$files{$_}{PATH}/$file_nm"; my $results = $dbh->do(q{update r_import_files set mod_user = ? , mod_date = sysdate , last_upload_date = null where product_category_key = ? and file_nm = ?}, undef, $REQUEST{USER}, $cat, $file_nm); &dienice('Database error at:' . __LINE__ . ' w/error: ' . " ($cat,$file_nm) " . $dbh->errstr) unless $results; } $status = sprintf(qq{%d files "REMOVED".\n}, $removed); } my ($cat, $file_nm) = split /=/, $REQUEST{FILE_KNOWN_AS}; my $upload ="$files{$REQUEST{FILE_KNOWN_AS}}{PATH}/$file_nm"; my $this_one = $upload; my $size = 0; my ($bytes_read, $buf); open (UPLOAD, ">$upload" ) or &dienice("Open UPLOAD failed from <$this_one> to <$upload>"); # # files from PC contain cntl + M - remember to remove while ($bytes_read = read($REQUEST{FILE},$buf,1024)) { $size += $bytes_read; print UPLOAD $buf; } close UPLOAD; system "chmod 0777 $upload"; $status .= sprintf('Uploaded %d bytes for file: %s', $size, $files{$REQUEST{FILE_KNOWN_AS}}{AKA}); my $results = $dbh->do(q{update r_import_files set mod_user = ?, mod_date = sysdate, last_upload_date = sysdate where product_category_key = ? and file_nm = ?}, undef, $REQUEST{USER}, $cat, $file_nm); &dienice('Database error at:' . __LINE__ . ' w/error: ' . $dbh->errstr) unless $results; &ShowRequest; } -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
