Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
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


In reply to Re: Problem with uploading file by Siddartha
in thread Problem with uploading file by Siddartha

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others chanting in the Monastery: (4)
    As of 2021-02-26 00:48 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found

      Notices?