Damn, like a bunch of damn women, Fighting at the Hair salon. My bikini cut is closer than yours! Nah! nah! nah! Well to comment on the guys actions, This isn't pro-Perl, Super-Perl, Kick-ass-perl. This Is beginners Perl. The dude never said he taught Perl, Never said he was a Super Perl Programmer. Never Said his Code was better than yours. Guy Just asked what he thought was a legitiment question to a Person he Obviously Respected. Than the Bloke Flames him? What, was it that your time of the month? You didn't feel like answering a simple coding question from a fellow professional Obviously needed help. Best regards: :) ----- Original Message ----- From: "Will Cottay" <[EMAIL PROTECTED]> To: <[EMAIL PROTECTED]> Sent: Thursday, July 12, 2001 7:41 AM Subject: Re: applause for Casey!!!!! APPLAUSE DUDE! ('Turning the tide...' and a911 plea for help) > 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 > > } > > } > >