jae_63 has asked for the wisdom of the Perl Monks concerning the following question:

In the past I've done a lot of (successful) command-line Perl debugging using syntax such as
perl -d:ptkdb foo.cgi "PARAM1=val1&PARAM2=val2"
where PARAM1 and PARAM2 are fields in the CGI form which invokes foo.cgi when the user presses the Submit button.

Now I would like to do the same thing, but two of the arguments are uploaded files, i.e. there's an HTML form which looks like:

<FORM ENCTYPE="multipart/form-data" ACTION="./foo.cgi" METHOD="POST"> Protease: <SELECT NAME="PARAM1"> <OPTION SELECTED>trypsin</OPTION> <OPTION>pepsin</OPTION> <OPTION>none</OPTION> </SELECT><br> Sort output by: <SELECT NAME="PARAM2"> <OPTION VALUE="mw" SELECTED>Molecular weight</OPTION> <OPTION VALUE="pos">Position</OPTION> </SELECT><br> <p> Please select an OBSERVED spectrum file to upload: <BR> <INPUT TYP +E="FILE" NAME="MEASURED_SPECTRUM"> <p> <p> Please select a protein sequence file to upload: <BR> <INPUT TYPE= +"FILE" NAME="SEQUENCE"> <p> <INPUT TYPE="submit"> </FORM>
and on the CGI side we have code such as:
my $q = new CGI; $fh1 = $q->param('MEASURED_SPECTRUM'); # these are really file-handles $fh2 = $q->param('SEQUENCE'); ... while (<$fh1>) { ... } ... while (<$fh2>) { ... }
Question: how can I invoke Perl from the command-line so that these file-handles are properly initialized?
Bonus question: In the (non-debug) CGI environment, is there any way to learn the name of the file which was uploaded? In the case of this program, the filename carries some semantic value.

Replies are listed 'Best First'.
Re: CGI.pm debugging with TYPE=FILE & ENCTYPE="multipart/form-data"
by Joost (Canon) on Feb 13, 2008 at 21:25 UTC
    Question: how can I invoke Perl from the command-line so that these file-handles are properly initialized?
    For any CGI program, setting the environment and STDIN with the right values should do it. I'm not sure if CGI.pm has any provisions for doing upload debugging, though it does pass command-line parameters to the script as if they're normal param()s if you don't do anything to the environment.

    I'd not be very surprised if there was a module on CPAN that would do this for you, but I never searched for one.

    See RFC 3875 or earlier.

Re: CGI.pm debugging with TYPE=FILE & ENCTYPE="multipart/form-data"
by pc88mxer (Vicar) on Feb 13, 2008 at 20:57 UTC
    To answer your bonus question, according to the CGI docs, $fh1 and $fh2 are not only file handles but also the entered file names.
Re: CGI.pm debugging with TYPE=FILE & ENCTYPE="multipart/form-data"
by Anonymous Monk on Feb 14, 2008 at 07:39 UTC
Re: CGI.pm debugging with TYPE=FILE & ENCTYPE="multipart/form-data"
by pc88mxer (Vicar) on Feb 14, 2008 at 16:10 UTC

    Here's code for a simple, single-threaded HTTP server which you can use to debug your perl CGI scripts. All requests will be directed to your code. I've tested it with file uploads, and it seems to work just fine.

    You can also use it to save requests to a file which can be useful for generating the input files required to test your CGI scripts off-line. See the comment near the end of the main loop.

    To use, insert your perl code in the call_cgi routine. It will listen on port 9000 (which can be changed by supplying a port number on the command line.) You'll also have change the ACTION parameter of your FORM to direct requests to this server (e.g. ACTION="http://localhost:9000/".)

    #!/usr/bin/perl # # quick and dirty signle threaded CGI executive # can also be used to capture requests use strict; use warnings; use IO::Socket::INET; use IO::String; my $port = shift(@ARGV) || 9000; my $listen = IO::Socket::INET->new( Listen => 5, LocalAddr => 'localhost', LocalPort => $port, Proto => 'tcp', ReuseAddr => 1 ); unless ($listen) { die "unable to listen on port $port: $!\n" }; while (1) { print STDERR "waiting for connection on port $port\n"; my $s = $listen->accept(); open(STDOUT, ">&=".fileno($s)); open(STDIN, "<&=".fileno($s)); my ($req, $content); delete $ENV{CONTENT_LENGTH}; { local ($/) = "\r\n"; while (<STDIN>) { $req .= $_; chomp; # print STDERR "got: $_\n"; last unless /\S/; if (/^GET\s*(\S+)/) { $ENV{REQUEST_METHOD} = 'GET'; (my $qs = $1) =~ m/\?(.*)/; $ENV{'QUERY_STRING'} = $1; } elsif (/^POST/) { $ENV{REQUEST_METHOD} = 'POST'; $ENV{'QUERY_STRING'} = ''; } elsif (/^Content-Type:\s*(.*)/) { $ENV{CONTENT_TYPE} = $1; } elsif (/^Content-Length:\s*(.*)/) { $ENV{CONTENT_LENGTH} = $1; } } } if (my $size = $ENV{CONTENT_LENGTH}) { $content = ''; while (length($content) < $size) { my $nr = read(STDIN, $content, $size-length($content), length($content)); die "read error" unless $nr; } } # can save $req, $content here: # open(F, ">request"); print F $req, $content; close(F); close(STDIN); # n.b.: does not close socket tie *STDIN, 'IO::String', $content; undef @CGI::QUERY_PARAM; call_cgi(); untie *STDIN; close(STDOUT); close($s); } sub call_cgi { print "HTTP/1.0 200\r\n"; # your CGI code goes here, example code follows use CGI; my $q = new CGI(); print $q->header(-type => 'text/plain'); print "Color = ", $q->param('color'), "\n"; my $file = $q->param('myfile'); print "myfile = ", $file, "\n"; print "myfile contents:\n"; while (<$file>) { print; } print "end of file\n"; }