The only reason I'm posting an example of how to do this is so
that I can feel better about commenting on just how excruciatingly
bad your code is.
I shudder to think that you are teaching software techniques to
anyone.
If you provided an example like that to Tom Christiansen, I'm not
surprised that he was a bit harsh with you. As far as asking him to
solve your little file upload problem, you should be embarrassed to
clutter his mail with such trivia.
BTW, I've been writing code since the 70's also and I'm a bit curious.
Have you got your first program running yet?
-will
#!/usr/bin/perl -w
use strict;
use CGI qw(:all);
my $q = new CGI;
print $q->header;
print $q->start_html(-title=>'File Upload Example');
my $filename = $q->param('img');
$| = 1;
print $q->start_multipart_form(-name=>'fup');
print $q->filefield(-name=>'img');
print "<input type='submit' name='sfile'></form>";
print $q->end_html;
if ($filename) {
my ($fn, $fout, $buffer, $bytesread);
($fn) = $filename =~ m!([^/|\\]+)$!;
$fout = $ENV{DOCUMENT_ROOT} . '/photos/ptmp/' . $fn;
open (OUTFILE,"> $fout") or die "Can't open $fout: $!";
print OUTFILE $buffer while ($bytesread = read($filename, $buffer, 1024));
close OUTFILE;
}
Cm wrote:
> Over a year ago I started learning Perl. I have been writing software
> since 1979, mostly medical and banking/brokerage stuff, so
> of all the languages, Java, ASP, C, whatever, I chose Perl because
> webmasters easily let it run on their hosted platforms...
>
> Then one day I wrote a letter to Tom Christenson describing a bug
> in Perl. Talk about getting flamed! He roasted me in a manner
> I would have responded with a physical assault had he been in the
> same room! It's not just that I am not so swift a Perl-man as he,
> but I TEACH KIDS software techniques and I have alot of patience
> with them and when a guy replies with a roasting lesson, he's
> just full of himself; sorry...my opinion.
>
> So, I sent him a coding example of the bug and here we are, two
> versions later; they never fixed it and it's a pretty major
> bug, in that alot of data can get lost when writing to files
> if you don't watch out... anyway, so I just write 'work-arounds'
> for it and figure Mr. Christenson has better fish to fry than
> me...
>
> But it left me with a totally bitter taste for Perl. It's a sweet
> language on the one-hand, yet as your article said, a rather
> sour group of coders. A few months later I asked Mr. Christ
> himself if he could kindly explain how to use CGI to capture
> an image from a form via CGI. I can capture text, buttons,
> selects, you name it, but I have yet to even get a reply
> as to how to have a user click on an html form, fill in
> a filename and send me a picture of themself, then, using
> method=post (which I an parse just fine thank you),
> set up a data stream to capture the image...
>
> So, here I come to you, Mr. Casey, man who wrote the first
> god damn Perl article that was timely and hopefully someone
> read... your 'Turning the tide...' and I ask you, please...
> is there a coding example of Perl and HTML combo SOMEWHERE
> that SOMEONE has (so I don't have to waste your time typing
> ..first you type this, then that etc.),
>
> that someone has to allow a client to upload a picture to
> my server. It took me 6 months to figure out how to
> sendmail, a year to figure out how to pop mail, and now, the
> last of the building blocks still eludes me... how to get
> a sweet smiling JPG picture from client to my server.
>
> I have attached an HTML doc I TRIED to use, via HTML/Java Script
> etc. and a piece of perl code that I TRIED to create to stream
> it... (I commented out the 'get user ID stuff', so the photo
> would always have the same name...no big deal)...
>
> and if you'd like to 'flame' (although I don't think that's your
> style), throw them, but please for god's sake, before I have
> to go to a friggin Java or Corba solution, can this be done
> in Perl and if so... HOW!!!!!!
>
> As for Mr. Christensen, at your next Perl symposium, remind him
> that when APPENDING to a DOS file that has a chr (26) (EOF)
> mark in it, Perl can't do it... ha ha... Now, if I wrote the
> C program that handled that aspect, I'd CHECK for a 26 in the
> last position of the file and if it existed, replace
> it with the first byte of the new string, then add a 26 to the
> end of the file... anyway... good luck and thank you in advance
> for ANY assistance you an offer regarding client to server
> jpg/gif CGI uploads...
>
> Craig Mead
>
> __________________________________________________
> Do You Yahoo!?
> Get personalized email addresses from Yahoo! Mail
> http://personal.mail.yahoo.com/
>
> ------------------------------------------------------------------------
> #!/usr/bin/perl
>
> push(@INC,"e:/10000diamonds/web/userscripts") ;
> push(@INC,"e:/10000diamonds/web/userscripts/Mods");
>
> $lmsg = "";
>
> #################### END OF VAR INITIALIZATION
>
> $sep = chr(123).chr(93);
> $photomsg = "Thank you for your picture.<br>It will be reviewed.<br>You may send up
>to 3 pictures.<br>";
> &tiptop;
> &nexthtml;
> exit;
>
> sub tiptop
> { $filedrive = "e:";
> $whatsys = "c:/bat/pathh.bat";
> ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime,
>$blksize, $blocks) = stat($whatsys);
> if ($size > 0)
> { $filedrive = "c:";
> }
> $datapath = "$filedrive/10000diamonds/web/data/";
> $picpath = $datapath;
> $picl = length($picpath)-5;
> $picpath = substr($picpath,0,$picl);
> $picpath = $picpath."pics";
> @ilines = undefined;
> $thiskey1 = "";
> $thiskey2 = "";
> ########## gettime debugged
> $nicedate = "";
> $nicetime = "";
> use Mods::gettime;
> gettime::mydate();
> $nicedate = $gettime::nicedate;
> $nicetime = $gettime::nicetime;
> #########
> if ($filedrive eq "e:")
> { use Socket;
> }
> $smtp_server = "mail5.hispeedhosting.com";
> $smtp_port = 25;
> $NT= 1;
>
> # TOP OF MAIN LOOP
> &ParseCgi;
> $ouruser = $FORMVALS{'username'};
> $ourfile = $FORMVALS{'yourpic'};
> $ourform = $FORMVALS{'formname'};
> $lmsg = "file was $ourfile";
> &lit;
> $newfile = "$picpath"."thephoto.jpg";
> # &finduser;
> if (length($newfile)>0)
> { &getphoto;
> }
> }
>
> sub getphoto
> { open FOTOFILE, ">$newfile";
> binmode FOTOFILE;
> open USERFILE, "<$ourfile";
> binmode USERFILE;
> $fotobyte = "";
> $bytecnt = 0;
> while ((read (FOTOFILE, $fotobyte, 1)) && (bytecnt < 50000))
> { print USERFILE $fotobyte;
> $bytecnt++;
> }
> close USERFILE;
> close FOTOFILE;
> if ($bytecnt > 50000)
> { $photomsg = "Your picture size exceeded the 50k limit!<br>Please try another
>photo!";
> }
> }
>
> sub finduser
> {
> # commented out
> }
>
> sub ParseCgi
> { my $Fwork,$Fkey,$Fvalue,$Fdata;
> if ($ENV{'REQUEST_METHOD'} eq "FILE")
> { $Fdata = uc($ENV{'QUERY_STRING'});
> $lmsg = "open $Fdata";
> &lit;
> open EFILE, "<$Fdata";
> @ELINES = <EFILE>;
> close EFILE;
> $Fwork = @ELINES[0];
> $lmsg = "Testparse $Fwork\n";
> &lit;
> }
> if ($ENV{'REQUEST_METHOD'} eq "GET")
> { $Fwork=$ENV{'QUERY_STRING'};
> $lmsg = "getting $Fwork\n";
> &lit;
> }
> $lmsg = "request method is $ENV{'REQUEST_METHOD'} and length is
>$ENV{'CONTENT_LENGTH'}\n";
> &lit;
> if ($ENV{'REQUEST_METHOD'} eq "POST")
> { read (STDIN,$Fwork,$ENV{'CONTENT_LENGTH'});
> $lmsg = "getting post of $Fwork with content length of
>$ENV{'CONTENT_LENGTH'}\n";
> &lit;
> }
> $Fwork =~ s/$sep/\&/g;
> $lmsg = "Environment $Fwork\n";
> &lit;
> foreach $Ftmp (split('&',$Fwork))
> { $Ftmp =~ s/\+/\ /g;
> $Ftmp =~ s/~is~/=/g;
> ($Fkey,$Fvalue) = $Ftmp =~ /(.+)=(.+)/;
> $Fvalue =~ s/%(..)/pack("c",hex($1))/ge;
> $Fkey =~ s/%(..)/pack("c",hex($1))/ge;
> $FORMVALS{$Fkey}=$Fvalue;
> push @FORMKEYS , $Fkey;
> push @FORMVARS , $Fvalue;
> $lmsg = "$Fkey was $FORMVALS{$Fkey}";
> &lit;
> }
> }
>
> sub lit
> { $lfilen = "$datapath"."dlog.htm";
> ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime,
>$blksize, $blocks) = stat($lfilen);
> if (index($lmsg, "Environment") == 0)
> { if (($size > 40000) || ($size < 10))
> { open LFILE, ">$lfilen";
> $tm = time();
> print LFILE "<html><title>10k SysLog</title><head></head><body
>bgcolor=green>\n";
> print LFILE "$tm <br>\n";
> close LFILE;
> }
> }
> open LFILE, ">>$lfilen";
> print LFILE "$oursesh $lmsg <br>\n";
> close LFILE;
> }
>
> sub nexthtml
> { if ($NT)
> { print "HTTP/1.0 302 OK\n";
> print "HTTP/1.0 200 OK\n";
> print "Content-type: text/html\n\n";
> print <<"EOT";
>
> <HTML>
> <HEAD>
> <META HTTP-EQUIV = "REFRESH" CONTENT = "60;
>URL=http://www.10000diamonds.com/gempub.html#Refresh";>
> </HEAD>
> <BODY bgcolor=red><font color=white><font size=+3>
> $photomsg
> <hr><a href="http://www.10000diamonds.com/getphoto.html";>Upload another photo</a>
> </BODY>
> </HTML>
> EOT
> }
> }
