Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Problem with uploading file

by Siddartha (Curate)
on Aug 15, 2001 at 16:03 UTC ( #105021=perlquestion: print w/ replies, xml ) Need Help??
Siddartha has asked for the wisdom of the Perl Monks concerning the following question:

I am writing a script to upload files to a server usinf CGI.pm.

My problem is that the parameters doesn't get passed to the cgi if I use the start_multipart_form method.

When I just use start_form(), everything works fine, except the file doesn't want to upload. As soon as I change it to start_multipart_form(), none of the name/value pairs gets sent, or I am not reading them correctly.

Snippet from form script:

print $query->start_multipart_form('POST','upload.cgi');
print $query->filefield('upload_file','',30,80);
print $query->submit("Upload");
print $query->endform();

Snippet from upload.cgi:

use CGI qw/:standard/;

$| = 1;

$query = new CGI;

$month = $query->param("month");
$year = $query->param("year");
$magazine = $query->param("magazine");

When I print these values, they are all undefined. When I change the form encoding by using startform(), everything works perfectly but I can't upload the file.

I have searched everywhere, but can't seem to find anything.

Please help

-Siddartha

Comment on Problem with uploading file
Re: Problem with uploading file
by tachyon (Chancellor) on Aug 15, 2001 at 17:11 UTC

    I think a little more code is in order. If you test the output example like this using the startform method and specifying 'multipart/form-data' instead of allowing it to default to 'application/x-www-form-urlencoded' you get exactly the same output as if you had used the start_multipart_form method as you show in your post:

    use CGI; my $query = new CGI; print $query->startform('POST','upload.cgi','multipart/form-data'); print $query->filefield('upload_file','',30,80); print $query->submit("Upload"); print $query->endform(); # the code above prints this using either startform as shown or start_ +multipart_form as in the posted code <form method="post" action="upload.cgi" enctype="multipart/form-data"> <input type="file" name="upload_file" size=30 maxlength=80 /> <input type="submit" name="Upload" value="Upload" /></form>

    So you can use either method (they just have different default encodings)

    I don't see where you expect to get your 'month', 'year', etc params from in the code given and don't see how the different default encoding from the two methods should make any difference to CGI.pm as it will handle params passed via either encoding just fine. So the options are either your CGI.pm is broken or you have a problem with your code. From what you have posted it is impossible to be certain but if I were a betting man I would be backing Lincoln.

    cheers

    tachyon

    s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

Re: Problem with uploading file
by Siddartha (Curate) on Aug 15, 2001 at 17:48 UTC
    Thanks for replying tachyon

    When I use the default encoding type with startform() it works, but as soon as I change it to 'multitype/form-data', it doesn't any more.

    I know it shouldn't make a differance but it does. I have updated my CGI module to 2.77 just in case there was a bug, but it still doesn't work.

    Basically all the name value pairs I read gets passed when using the default encoding type but not when I change it.

    Anyway, here is the code:

    login.cgi

    #!/usr/bin/perl use CGI; $| = 1; $query = CGI::new(); $passfile = "/*****/***.cfg"; $dir = "/Volumes/*****/pdf/magazines/"; $menu = $query->param("menu"); $name = $query->param("name"); $password = $query->param("password"); $rights = ''; if (!(defined($menu))) { if (!(defined($name))) { print $query->redirect('pdf_login.cgi'); }; my $cookie_name = $query->cookie("name"); if ($cookie_name ne $name) { my $cookie = $query->cookie (-name => 'name', -value => $name, -expires => '+10y'); print $query->redirect (-cookie => $cookie, -uri => $query->se +lf_url()); exit 0; }; } else { my $cookie_name = $query->cookie("name"); $name = $cookie_name; }; my $cookie_pass = $query->cookie("pass"); open (IN, "$passfile") || die "Can't open $passfile for appending!\n"; my $readname = ""; while (<IN>) { ($readname,$pass,$right) = split(/:/); if ($name eq $readname) { $mypass = $pass; if ($cookie_pass eq $pass) { $rights = $right; } else { if (crypt($password,$pass) eq $pass) { $rights = $right; } else { print $query->header(); print "<HTML>\n<HEAD>\n<TITLE></TITLE>\n"; print " </HEAD>\n <META HTTP-EQUIV=\"Refresh\" CONTENT=\"2;URL=pdf_login +.cgi\"> <BODY MARGINHEIGHT=0 MARGINWIDTH=0 LEFTMARGIN=0 TOPMAR +GIN=0 BGCOLOR=\"FFFFFF\"> "; print " <TABLE WIDTH=\"100%\" BORDER=0 CELL +PADDING=0 CELLSPACING=0>\n <TR>\n <TD>\n </TD>\n <TD> <IMG SRC=\"../pdf/images/ba2.jpg\" ALIGN='RIGH +T' WIDTH=201 HEIGHT=78></TD> </TR>\n <TR>\n <TD COLSPAN=2>\n"; print "<FONT SIZE=3 FACE=\"ARIAL\"> <CENTER> <BR><BR> <BR>Wrong Password<BR><BR></CENTER>"; print " </TD>\n </TR>\n </TABLE>\n </BODY>\n </HTML>\n "; exit 0; }; # end else }; #end else }; #end if print $readname; }; #end while if ($rights eq "") { print $query->header(); print "<HTML>\n<HEAD>\n<TITLE></TITLE>\n "; print " </HEAD>\n <META HTTP-EQUIV=\"Refresh\" CONTENT=\"2;URL=pdf_login +.cgi\"> <BODY MARGINHEIGHT=0 MARGINWIDTH=0 LEFTMARGIN=0 TOPMAR +GIN=0 BGCOLOR=\"FFFFFF\"> "; print " <TABLE WIDTH=\"100%\" BORDER=0 CELL +PADDING=0 CELLSPACING=0>\n <TR>\n <TD>\n </TD>\n <TD> <IMG SRC=\"../pdf/images/ba2.jpg\" ALIGN='RIGH +T' WIDTH=201 HEIGHT=78></TD> </TR>\n <TR>\n <TD COLSPAN=2>\n"; print "<FONT SIZE=3 FACE=\"ARIAL\"> <CENTER> <BR><BR>Please log in with an approved username.<BR>< +BR><BR></CENTER>"; print " </TD>\n </TR>\n </TABLE>\n </BODY>\n </HTML>\n "; exit 0; }; close (IN); if (((defined $password)) and ($cookie_pass ne crypt($password,$my +pass))) { my $cookie = $query->cookie (-name => 'pass', -value => crypt($password,$mypass)); print $query->redirect (-cookie => $cookie, -uri => $query->se +lf_url()); exit 0; }; print "Cache-Control: no-cache\nPragma: no-cache\n"; print $query->header(); print "<HTML>\n<HEAD>\n<TITLE></TITLE>\n"; print " </HEAD>\n <BODY MARGINHEIGHT=0 MARGINWIDTH=0 LEFTMARGIN=0 TOPMAR +GIN=0 BGCOLOR=\"FFFFFF\"> "; print " <TABLE WIDTH=\"100%\" BORDER=0 CELLPADDING= +0 CELLSPACING=0>\n <TR>\n <TD>\n </TD>\n <TD> <IMG SRC=\"../pdf/images/ba2.jpg\" ALIGN='RIGH +T' WIDTH=201 HEIGHT=78></TD> </TR>\n <TR>\n <TD COLSPAN=2>\n <CENTER><BR><BR>Welcome $name.<BR><BR></CENTER +>\n <CENTER><TABLE BGCOLOR='#EEEEEE' BORDER=1 CELL +PADDING=5 CELLSPACING=5>\n <TR>\n"; if ($rights eq "A\n") { &outputA; }; if ($rights eq "C\n") { &outputC; }; if ($rights eq "AC\n") { &outputA; &outputC; }; if ($rights eq "ACU\n") { &outputA; &outputC; &outputU; }; print " </TR></TABLE></CENTER>\n </TD>\n </TR>\n </TABLE>\n </BODY>\n </HTML>\n "; exit 0; sub outputA { print "<TD><FONT SIZE=3 FACE=\"ARIAL\"> <CENTER> <BR> Choose a date to approve: <BR><BR>"; opendir(DIR, $dir) or die "Can not opendir $dir"; @mags = grep !/^\.\.?$/, readdir(DIR); closedir(DIR); foreach $magazine (@mags) { print "<HR><BR><CENTER>$magazine</CENTER><BR><BR> +"; opendir(DIR, "$dir/$magazine") or die "Can not o +pendir $dir/$magazine"; @files = grep { /^\d+$/ } readdir(DIR); closedir(DIR); foreach $filename (@files) { @months = ('January','February','March','April','May', +'June','July', 'August','September','October','November','Decemb +er'); $month = int substr($filename,4); $mfilename = $months[$month-1]." ".substr($filename,0,4 +); print "<A HREF= \"pdf.cgi?mag=$magazine&month +=$filename\" TARGET=\"_self\">$mfilename</A><BR><BR>\n"; }; }; print "<HR></CENTER></TD>"; }; sub outputC { print "<TD><FONT SIZE=3 FACE=\"ARIAL\"> <CENTER> <BR>View submitted comments:<BR><BR>\n"; opendir(DIR, $dir) or die "Can not opendir $dir"; @mags = grep !/^\.\.?$/, readdir(DIR); closedir(DIR); foreach $magazine (@mags) { print "<HR><BR><CENTER>$magazine</CENTER><BR><BR> +"; opendir(DIR, "$dir/$magazine") or die "Can not o +pendir $dir/$magazine"; @files = grep { /^\d+$/ } readdir(DIR); closedir(DIR); foreach $filename (@files) { @months = ('January','February','March','April','May','Jun +e','July', 'August','September','October','November','Decemb +er'); $month = int substr($filename,4); $mfilename = $months[$month-1]." ".substr($filename,0,4 +); print "<A HREF= \"pdf3.cgi?mag=$magazine&mont +h=$filename\" TARGET=\"_self\">$mfilename</A><BR><BR>\n"; }; }; print "<HR></CENTER></TD>"; }; sub outputU { print "<TD><FONT SIZE=3 FACE=\"ARIAL\"> <CENTER> <BR>Upload Files:<BR><HR>\n"; print $query->start_form('POST','upload.cgi','multipa +rt/form-data'); opendir(DIR, $dir) or die "Can not opendir $dir"; @mags = grep !/^\.\.?$/, readdir(DIR); closedir(DIR); print "<BR><b>Magazine:</b><BR>"; print $query->popup_menu(-name=>'magazine', -values=>[@mags]); print "<BR><BR><b>Edition:</b><BR>"; @months = ('January','February','March','April','May' +,'June','July', 'August','September','October','November','Decemb +er'); print $query->popup_menu(-name=>'month', -values=>[@months]); print "<BR><BR><b>Year:</b><BR>"; print $query->textfield('year','2001',4) . "\n"; print "<BR><BR><b>File to upload:</b><BR>"; print $query->filefield('upload_file','',30,80); print "<CENTER>"; print $query->submit("Upload"); print "</CENTER><BR>\n\n"; print $query->endform(); print "<HR></CENTER></TD>"; };

    I know it is not the cleanest or best way to do it, lots of repetition, but bare with me.

    And here is upload.cgi:

    #!/usr/bin/perl use CGI qw/:standard/; $| = 1; $query = new CGI; $month = $query->param("month"); $year = $query->param("year"); $magazine = $query->param("magazine"); %months = ('January','01','February','02','March','03','April','04', +'May','05','June','06','July','07', 'August','08','September','09','October','10','No +vember',11,'December','12'); my $mymonth = $year . $months{$month}; my $dir = "/Volumes/*****/pdf/magazines/$magazine/$mymonth"; my $name = $query->cookie("name"); if (!(defined($name)) or ($name eq '')) { print $query->redirect('pdf_login.cgi'); } else { print $query->header(); print "<HTML>\n<HEAD>\n<TITLE>$name</TITLE>\n"; print " </HEAD>\n <BODY MARGINHEIGHT=0 MARGINWIDTH=0 LEFTMARGIN=0 TOPMARGIN=0 BGCOLOR=\" +FFFFFF\"> <FONT SIZE=3 FACE=\"ARIAL\"> "; my $bytes_read=0; my $size=''; my $buff=''; my $filename=''; my $write_file=''; my $filepath=''; $filepath=$query->param("upload_file"); if ($filepath =~ /([^\/\\]+)$/) { $filename="$1"; } else { $filename="$filepath"; } $write_file="$dir" . "/" . "$filename"; print "$dir,$mymonth,$month,$magazine,$name,$filepath<BR>\n"; print "Filename=$filename<br>\n"; print "Writefile= $write_file<br>\n"; if (!open(WFD,">>$write_file")) { die("Error opening $write_file for writing"); return; } while ($bytes_read=read($filepath,$buff,1024)) { binmode WFD; print WFD $buff; } close(WFD); if ((stat $write_file)[7] <= 0) { unlink($write_file); die("Could not upload file: $filename"); return; } else { print<<EOF; <center> <hr noshade size=1 width="90%"> <table border=0 bgcolor="#c0c0c0" cellpadding=0 cellspacing=0> <tr> <td> <table border=0 width="100%" cellpadding=10 cellspacin +g=2> <tr align="center"> <td bgcolor="#000099" width="100%"> <font color="#ffffff"> File <font color="#00ffff"><b>$filename</b></font> +of size <font color="#00ffff"><b>$size</b></font> byte +s is uploaded successfully! </font> </td> </tr> </table> </td> </tr> </table> </center> EOF ; } print " </BODY>\n </HTML>\n "; }; exit 0;

    I really hope I just did something stupid.

    Thanks for your help

    -Siddartha

      First thing I can see is that you ask CGI.pm for the function interface via the use CGI qw(:standard) but then go on to use the OO methods. Change to just use CGI; and see if that fixes it. If it does report the bug!

      cheers

      tachyon

      s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

        No it doesn't fix it.

        -Siddartha

Re: Problem with uploading file
by Siddartha (Curate) on Aug 16, 2001 at 15:00 UTC
    Thanks for all the help tachyon

    good news, I installed CGI.pm again and everything seems to be working perfectly now.

    It's really weird, when I installed it with CPAN, it doesn't work, but when I manually downloaded it and dropped it in the right place it works. The weird thing is that it is exactly the same version.

    Thanks a lot for all your help!

    -Siddartha

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://105021]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2014-09-22 01:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (176 votes), past polls