Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

poj's scratchpad

by poj (Monsignor)
on Jun 12, 2013 at 17:16 UTC ( #1038520=scratchpad: print w/replies, xml ) Need Help??

A few ideas. Use a hash for filetype to avoid searching for a value. Define it at the start and then you can check the filetype and skip to the end if wrong.

my %filetype = ( sum => ["Summary_${date_ntime}_x.csv", 'csv' ], res => ["Results_${date_ntime}_y.txt", 'txt' ], his => ["History_${date_ntime}_z.xlsx",'xlsx'], );

I would rename the parameter doc and $got_doc_name so it is clear it is the type of file and not the name of the uploaded file.

# This is the value of the type of the file being uploaded. my $got_doc_type = $cgi->param( 'doc_type' ) || '';

The main loop then becomes

# check filename my $newname = $filetype{$got_doc_type}[0]; my $ext = $filetype{$got_doc_type}[1]; my $tmpname; if ($ext && $got_file_name =~ /\.$ext$/){ # Process file my $fh = $cgi->upload( 'doc_upload' ); $tmpname = $cgi->tmpFileName($fh); process_request($tmpname,$newname); } else { warn "Wrong file type [$ext]."; $tmpname = 'Wrong file type'; }

I think you can ftp the temp file without renaming it see Net::FTP

sub process_request { my ($tmpname,$file_renamed) = @_; return unless $file_renamed; # FTP FILE. my $host = 'xxx'; my $user = 'yyy'; my $pwd = 'zzz'; my $ftp_dir = '/'; my $ftp = Net::FTP->new($host, Debug => 0, Passive => 0) or die "Could not connect to '$host': $@"; $ftp->login($user, $pwd) or die sprintf "Could not login: %s", $ftp->message; $ftp->cwd($ftp_dir) or die sprintf "Could not login: %s", $ftp->message; # Get a list of files in the FTP server my @retrived = $ftp->ls("file_types"); if (@retrived) { warn " File $file_renamed already exists in server."; } else { warn " *$file_renamed*"; my $put_file = $ftp->put($tmpname,$file_renamed) or die "Cannot put file ", $ftp->message; warn " FTP transaction was successful for file(s): $put_file"; } $ftp->quit; }

This was my full test script

#!/usr/bin/perl # upload2.cgi use strict; use warnings; use CGI; use HTML::Template; use Time::Piece; use CGI::Session; use Data::Dumper; use Net::FTP; # File date string my $date_ntime = localtime->strftime('%Y%m%d%H%M%S'); my %filetype = ( sum => ["Summary_${date_ntime}_x.csv", 'csv' ], res => ["Results_${date_ntime}_y.txt", 'txt' ], his => ["History_${date_ntime}_z.xlsx",'xlsx'], ); my $cgi = CGI->new(); # Create new session my $session = new CGI::Session("driver:File", $cgi, {Directory => "c:/ +temp/web"}) or die CGI::Session->errstr; my $sid = $session->id(); # Check app access - if not authorized show admins my $user_name = "XYZ"; # This is the value of the type of the file being uploaded. my $got_doc_type = $cgi->param( 'doc_type' ) || ''; # Store the file name been uploaded so we can use it to inform the use +r later. # Add the session parameter in here. Use .= to ensure a string and not + a file handle. my $got_file_name .= $cgi->param( 'doc_upload' ) || $session->param( ' +doc_uploaded' ) || ''; # Write the session to disk with flush $session->param("doc_uploaded", $got_file_name); $session->flush(); # check filename my $newname = $filetype{$got_doc_type}[0]; my $ext = $filetype{$got_doc_type}[1]; my $tmpname; if ($ext && $got_file_name =~ /\.$ext$/){ # Process file my $fh = $cgi->upload( 'doc_upload' ); $tmpname = $cgi->tmpFileName($fh); #process_request($tmpname,$newname); save_doc($fh,$newname); } else { warn "Wrong file type [$ext]."; $tmpname = 'Wrong file type'; } =head1 # Load this value into the template my $tmpl = HTML::Template->new( filename => 'templates/test_up.tmpl', die_on_bad_params => 0, associate => $session); $tmpl->param( USER_NAME => $user_name ); =cut my $cookie = $cgi->cookie(CGISESSID => $sid); #print $cgi->header(-cookie=>$cookie ), $tmpl->output; print $cgi->header(-cookie=>$cookie ),$cgi->start_html; print $cgi->pre(" got_doc_type [$got_doc_type] got_file_name[$got_file_name] newname [$newname] ext [$ext] tmpname [$tmpname] "),$cgi->end_html; exit; sub save_doc { my ($fh,$filename) = @_; my $dir = 'c:/temp/web/'; open my $out,'>',$dir.$filename or die "Could not open $dir$filename $!"; binmode $out; print $out $_ while <$fh>; close $out; } # ftp the temp file sub process_request { my ($tmpname,$file_renamed) = @_; return unless $file_renamed; # FTP FILE. my $host = 'xxx'; my $user = 'yyy'; my $pwd = 'zzz'; my $ftp_dir = '/'; my $ftp = Net::FTP->new($host, Debug => 0, Passive => 0) or die "Could not connect to '$host': $@"; $ftp->login($user, $pwd) or die sprintf "Could not login: %s", $ftp->message; $ftp->cwd($ftp_dir) or die sprintf "Could not login: %s", $ftp->message; # Get a list of files in the FTP server my @retrived = $ftp->ls("file_types"); if (@retrived) { warn " File $file_renamed already exists in server."; } else { warn " *$file_renamed*"; my $put_file = $ftp->put($tmpname,$file_renamed) or die "Cannot put file ", $ftp->message; warn " FTP transaction was successful for file(s): $put_file"; } $ftp->quit; }

HTML form

<html>
<head>
 <title>File Upload</title>
</head>
<body>
 <form action="/test/upload2.cgi" method="post" ENCTYPE="multipart/form-data">
  <input type="text" name="doc_type"/>
<input type="file" name="doc_upload"/>
<input type="submit" name="submit" value="submit form"> </form> </body> </html>
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (4)
As of 2018-02-25 13:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    When it is dark outside I am happiest to see ...














    Results (312 votes). Check out past polls.

    Notices?