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
}
}
