[24246] in Perl-Users-Digest
Perl-Users Digest, Issue: 6437 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Apr 21 03:10:41 2004
Date: Wed, 21 Apr 2004 00:10:13 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Wed, 21 Apr 2004 Volume: 10 Number: 6437
Today's topics:
more code...(unfinished) <robin @ infusedlight.net>
Re: more code...(unfinished) <robin @ infusedlight.net>
Re: more code...(unfinished) <tassilo.parseval@rwth-aachen.de>
Re: more code...(unfinished) <uri@stemsystems.com>
Re: more code...(unfinished) <uri@stemsystems.com>
Re: need Regular Expression to remove all non-numerical <robin @ infusedlight.net>
Re: Request for program test on different operating syt <t@REMOVETHISbrowse.to>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 20 Apr 2004 23:27:51 -0700
From: "Robin" <robin @ infusedlight.net>
Subject: more code...(unfinished)
Message-Id: <c655f9$s4b$1@reader2.nmix.net>
#!/usr/bin/perl
use Fcntl qw (:flock);
use strict;
use warnings;
use CGI qw(:all);
$CGI::POST_MAX=1024 * 100; # max 100K posts
$CGI::DISABLE_UPLOADS = 1; # no uploads
$" = '';
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
my $homepage = "http://www.infusedlight.net"; #change this to your homepage
my $string = '<--->';
my $string2 = '<---->';
my $version = '1.0.0';
my $bookfile = 'book.txt';
my $headerfile = 'header.txt';
my $footerfile = 'footer.txt';
my $DATE = getdate();
my @head = gethead ($headerfile);
my @foot = getfoot ($footerfile);
if (url_param ('action') eq "sign")
{
sign();
}
elsif (url_param ('action') eq "dosign")
{
dosign();
}
else
{
if (! -e $bookfile)
{
if (open (BOOKFILE, ">$bookfile"))
{
flock (BOOKFILE, LOCK_EX);
print BOOKFILE '';
flock (BOOKFILE, LOCK_UN);
close (BOOKFILE);
}
else
{
print header and print "<center><strong>Viewing Guestbook - Version
$version - No guests</strong><hr><a href=\"$homepage\">To
homepage</a></center>" and exit;
}
}
view (1);
}
sub sign
{
print header;
print (@head);
print <<END;
<div align="center">
<p><strong>GBOOK2 - Sign Guestbook - Version $version</strong></p>
<hr size="1">
<form name="form1" method="post" action="gbook.pl?action=dosign">
<table width="85%" border="1" align="center" cellpadding="3"
cellspacing="0" bordercolor="#660000">
<tr>
<td width="50%" bgcolor="#CCCCCC">Your name:</td>
<td width="50%" bgcolor="#999999">
<div align="center">
<input name="name" type="text" id="name">
</div></td>
</tr>
<tr>
<td bgcolor="#999999">Your email: </td>
<td bgcolor="#CCCCCC"><div align="center">
<input name="email" type="text" id="email">
</div></td>
</tr>
<tr>
<td bgcolor="#CCCCCC">Your web site name (not required):</td>
<td bgcolor="#999999"><div align="center">
<input type="text" name="webname">
</div></td>
</tr>
<tr>
<td bgcolor="#999999">Your web site URL (not required):</td>
<td bgcolor="#CCCCCC"><div align="center">
<input name="url" type="text" id="url">
</div></td>
</tr>
<tr>
<td bgcolor="#CCCCCC">Your message: </td>
<td bgcolor="#999999"><div align="center">
<textarea name="message" cols="35" rows="4"
id="message"></textarea>
</div></td>
</tr>
<tr>
<td bgcolor="#333399">
<div align="right">
<input type="submit" name="Submit" value="Submit">
</div></td>
<td bgcolor="#333399">
<div align="left">
<input type="reset" name="Submit2" value="Reset">
</div></td>
</tr>
</table>
</form>
<hr size="1">
</div>
END
print (@foot);
}
sub dosign
{
if (checkforcookie() eq "true")
{
# print header;
# print (@head);
#print ("<center>You have already signed the guestbook once today.
Please sign it again tommorow.<hr></center>");
#print (@foot);
#exit;
}
my $name = param ('name');
my $email = param ('email');
my $website = param ('webname') . $string2 . param ('url');
my $message = param ('message');
if (param ('url') !~ /<.*>/ and param ('webname') !~ /<.*>/ and param
('url') !~ /^\s*$/s and param ('webname') !~ /$string2|$string/ and param
('url') !~ /$string2|$string/)
{
my (@url);
@url = split (/$string2/, $website);
if ($url[1] ne '' and $url[0] eq '')
{
$website = <<END;
<a href="$url[1]">$url[1]</a>
END
}
elsif ($url[0] ne '' and $url[1] ne '')
{
$website = <<END;
<a href="$url[1]">$url[0]</a>
END
}
elsif ($url[0] ne '' and $url[1] eq '')
{
$website = 'None';
}
elsif ($url[0] eq '' and $url[1] eq '')
{
$website = 'None';
}
}
else
{
$website = 'None';
}
if ($name !~ /^\s*$/g and $email !~ /^\s*$/g and $message !~ /^\s*$/g and
$email !~ /<.*>/s and param ('webname') !~ /<.*>/g and param ('url') !~
/<.*>/g and $name !~ /<.*>/s and $name !~ /$string/g and $message !~
/$string/g and $website !~ /$string/g and $email !~ /$string/g and $name !~
/$string2/g and $message !~ /$string2/g and $email !~ /$string2/g and param
('webname') !~ /$string2/g and param ('url') !~ /$string2/g)
{
open (BOOKFILE, ">>$bookfile") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (BOOKFILE, LOCK_EX);
print BOOKFILE <<"END";
<div align="center">
<table width="75%" border="1" cellpadding="3" cellspacing="0"
bordercolor="#660000" align="center">
<tr>
<td>Date of message: </td>
<td>$DATE</td>
</tr>
<tr>
<td width="50%">Name:</td>
<td width="50%">$name</td>
</tr>
<tr>
<td width="50%">Email:</td>
<td width="50%">$email</td>
</tr>
<tr>
<td>Website:</td>
<td>$website</td>
</tr>
<tr>
<td>Message:</td>
<td>$message</td>
</tr>
</table>
<hr size="1">
$string
END
flock (BOOKFILE, LOCK_UN);
close (BOOKFILE);
chmod (0770, $bookfile);
setcookie ("gbook.pl");
exit;
}
else
{
printerror1 ();
}
}
sub view
{
my ($header) = @_;
open (BOOKFILE, $bookfile) or print header and print
"<center><strong>Viewing Guestbook - Version $version - No
guests</strong><hr><a href=\"$homepage\">To homepage</a></center>" and exit;
flock (BOOKFILE, LOCK_SH);
my @contentsofbook=<BOOKFILE>;
flock (BOOKFILE, LOCK_UN);
close (BOOKFILE);
my $contentsofbook=join('', @contentsofbook);
@contentsofbook = split (/$string/, $contentsofbook);
@contentsofbook = reverse (@contentsofbook);
my $len = @contentsofbook;
$len -= 1;
my $s;
$s = 's' if ($len > 1);
print header if ($header);
print (@head);;
print <<END;
<div align="center">
<strong>GBOOK2 - Viewing Guestbook - Version $version - $len
guest$s</strong>
<hr size="1"><a href="$homepage">To homepage</a><br><br>
END
printpages();
print "<br><br>";
if (@contentsofbook)
{
print @contentsofbook;
}
else
{
print "No guests.";
}
if (! @contentsofbook)
{
print "<br>";
}
printpages();
print "<br><br>";
print <<END;
<a href="$homepage">To homepage</a></div>
END
print (@foot);
exit;
}
sub printpages
{
my ($counter, $counter2, $base, $end);
open (BOOKFILE, $bookfile) or print "An error occured during this
operation. Please try again.";
flock (BOOKFILE, LOCK_SH);
my @contentstoprint = <BOOKFILE>;
flock (BOOKFILE, LOCK_UN);
close (BOOKFILE);
$counter = 0;
$counter2 =1;
$base = 0;
$end = 9;
my $contentstoprint = join ('', @contentstoprint);
@contentstoprint = split (/$string/, $contentstoprint);
@contentstoprint = reverse (@contentstoprint);
my $content1;
print "Pages: [ <a href=\"gbook.pl?start=$base&end=$end\">1</a> ] ";
foreach $content1 (@contentstoprint)
{
$counter += 1;
$base += 1;
$end += 1;
if ($counter == 10)
{
$counter2 += 1;
print "[ <a href=\"gbook.pl?start=$base&end=$end\">$counter2</a> ] ";
$counter = 0;
}
}
}
sub printerror1
{
print header;
print (@head);
print ("<center>You did not supply the required fields or you used HTML
tags which are not allowed on this guestbook.<hr></center>");
print (@foot);
exit;
}
sub gethead
{
my ($header) = @_;
my @header;
if (-e "$header")
{
open (HEADER, "$header") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (HEADER, LOCK_SH);
@header = <HEADER>;
flock (HEADER, LOCK_UN);
close (HEADER);
}
else
{
open (HEADER, ">$header") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (HEADER, LOCK_EX);
print HEADER <<END;
<html>
<head>
<title>GBOOK2 Version $version</title>
</head>
<body>
END
flock (HEADER, LOCK_UN);
close (HEADER);
open (HEADER, "$header") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (HEADER, LOCK_SH);
@header = <HEADER>;
flock (HEADER, LOCK_UN);
close (HEADER);
}
chmod (0770, $header);
return @header;
}
sub getfoot
{
my ($footer) = @_;
my @footer;
if (-e "$footer")
{
open (FOOTER, "$footer") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (FOOTER, LOCK_SH);
@footer = <FOOTER>;
flock (FOOTER, LOCK_UN);
close (FOOTER);
}
else
{
open (FOOTER, ">$footer") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (FOOTER, LOCK_EX);
print FOOTER <<END;
</body></html>
END
close (FOOTER);
open (FOOTER, "$footer") or print header and print "An error occured
during this operation: <b>$!</b>. Please press the back button on your
browser and try again.<hr>" and exit;
flock (FOOTER, LOCK_SH);
@footer = <FOOTER>;
flock (FOOTER, LOCK_UN);
close (FOOTER);
}
chmod (0770, $footer);
return @footer;
}
sub getdate
{
open (DATE, "date +%D|") or print header and print "Date could not be
obtained. Please contact your system's administrator.<hr>" and exit;
my $date = <DATE>;
$date =~ s/\n//g;
$date =~ s/\r//g;
close (DATE);
return ($date);
}
sub setcookie
{
my ($redir) = @_;
my $cookie;
$cookie = cookie (-name=>'signed', -value=>"signed", -expires=>'+1d');
print redirect (-url=>"$redir", -cookie=>"$cookie");
}
sub checkforcookie
{
my $cookieflag;
$cookieflag = '';
if (getcookie() eq 'signed')
{
$cookieflag = 'true';
}
return ($cookieflag);
}
sub getcookie
{
my $cookiein;
$cookiein = cookie ('signed');
return $cookiein;
}
begin 666 gbook.pl
M(R$O=7-R+V)I;B]P97)L#0H-"G5S92!&8VYT;"!Q=R H.F9L;V-K*3L-"G5S
M92!S=')I8W0[#0IU<V4@=V%R;FEN9W,[#0H-"G5S92!#1TD@<7<H.F%L;"D[
M#0H-"B1#1TDZ.E!/4U1?34%8/3$P,C0@*B Q,# [(" C(&UA>" Q,#!+('!O
M<W1S#0HD0T=).CI$25-!0DQ%7U503$]!1%,@/2 Q.R @(R!N;R!U<&QO861S
M#0H-"B0B(#T@)R<[#0H-"B1%3E9[)U!!5$@G?2 ]("<O8FEN.B]U<W(O8FEN
M.B]U<W(O;&]C86PO8FEN)SL-"@T*;7D@)&AO;65P86=E(#T@(FAT=' Z+R]W
M=W<N:6YF=7-E9&QI9VAT+FYE="([("-C:&%N9V4@=&AI<R!T;R!Y;W5R(&AO
M;65P86=E#0IM>2 D<W1R:6YG(#T@)SPM+2T^)SL-"FUY("1S=')I;F<R(#T@
M)SPM+2TM/B<[#0IM>2 D=F5R<VEO;B ]("<Q+C N,"<[#0IM>2 D8F]O:V9I
M;&4@/2 G8F]O:RYT>'0G.PT*;7D@)&AE861E<F9I;&4@/2 G:&5A9&5R+G1X
M="<[#0IM>2 D9F]O=&5R9FEL92 ]("=F;V]T97(N='AT)SL-"FUY("1$051%
M(#T@9V5T9&%T92@I.PT*;7D@0&AE860@/2!G971H96%D("@D:&5A9&5R9FEL
M92D[#0IM>2! 9F]O=" ](&=E=&9O;W0@*"1F;V]T97)F:6QE*3L-"@T*:68@
M*'5R;%]P87)A;2 H)V%C=&EO;B<I(&5Q(")S:6=N(BD-"@E[#0H)<VEG;B@I
M.PT*"7T-"@T*96QS:68@*'5R;%]P87)A;2 H)V%C=&EO;B<I(&5Q(")D;W-I
M9VXB*0T*"7L-"@ED;W-I9VXH*3L-"@E]#0IE;'-E#0H)>PT*"6EF("@A("UE
M("1B;V]K9FEL92D-"@D)>PT*"0EI9B H;W!E;B H0D]/2T9)3$4L("(^)&)O
M;VMF:6QE(BDI#0H)"0E[#0H)"0EF;&]C:R H0D]/2T9)3$4L($Q/0TM?15@I
M.PT*"0D)<')I;G0@0D]/2T9)3$4@)R<[#0H)"0EF;&]C:R H0D]/2T9)3$4L
M($Q/0TM?54XI.PT*"0D)8VQO<V4@*$)/3TM&24Q%*3L-"@D)"7T-"B @(" @
M(" @96QS90T*(" @(" @(" )>PT*(" @(" @(" )<')I;G0@:&5A9&5R(&%N
M9"!P<FEN=" B/&-E;G1E<CX\<W1R;VYG/E9I97=I;F<@1W5E<W1B;V]K("T@
M5F5R<VEO;B D=F5R<VEO;B M($YO(&=U97-T<SPO<W1R;VYG/CQH<CX\82!H
M<F5F/5PB)&AO;65P86=E7"(^5&\@:&]M97!A9V4\+V$^/"]C96YT97(^(B!A
M;F0@97AI=#L-"B @(" @(" @"7T-"B @(" @(" @?0T*"79I97<@*#$I.PT*
M"7T-"@T*<W5B('-I9VX-"@E[#0H)<')I;G0@:&5A9&5R.PT*"7!R:6YT("A
M:&5A9"D[#0H)<')I;G0@/#Q%3D0[#0H\9&EV(&%L:6=N/2)C96YT97(B/@T*
M(" \<#X\<W1R;VYG/D="3T]+,B M(%-I9VX@1W5E<W1B;V]K("T@5F5R<VEO
M;B D=F5R<VEO;CPO<W1R;VYG/CPO<#X-"B @/&AR('-I>F4](C$B/@T*(" \
M9F]R;2!N86UE/2)F;W)M,2(@;65T:&]D/2)P;W-T(B!A8W1I;VX](F=B;V]K
M+G!L/V%C=&EO;CUD;W-I9VXB/@T*(" @(#QT86)L92!W:61T:#TB.#4E(B @
M8F]R9&5R/2(Q(B!A;&EG;CTB8V5N=&5R(B!C96QL<&%D9&EN9STB,R(@8V5L
M;'-P86-I;F<](C B(&)O<F1E<F-O;&]R/2(C-C8P,# P(CX-"B @(" @(#QT
M<CX-"B @(" @(" @/'1D('=I9'1H/2(U,"4B(&)G8V]L;W(](B-#0T-#0T,B
M/EEO=7(@;F%M93H\+W1D/@T*(" @(" @(" \=&0@=VED=&@](C4P)2(@8F=C
M;VQO<CTB(SDY.3DY.2(^#0H@(" @(" @(" @/&1I=B!A;&EG;CTB8V5N=&5R
M(CX-"B @(" @(" @(" @(#QI;G!U="!N86UE/2)N86UE(B!T>7!E/2)T97AT
M(B!I9#TB;F%M92(^#0H@(" @(" @(" @(" \+V1I=CX\+W1D/@T*(" @(" @
M/"]T<CX-"B @(" @(#QT<CX-"B @(" @(" @/'1D(&)G8V]L;W(](B,Y.3DY
M.3DB/EEO=7(@96UA:6PZ(#PO=&0^#0H@(" @(" @(#QT9"!B9V-O;&]R/2(C
M0T-#0T-#(CX\9&EV(&%L:6=N/2)C96YT97(B/@T*(" @(" @(" @(#QI;G!U
M="!N86UE/2)E;6%I;"(@='EP93TB=&5X="(@:60](F5M86EL(CX-"B @(" @
M(" @/"]D:78^/"]T9#X-"B @(" @(#PO='(^#0H@(" @(" \='(^#0H@(" @
M(" @(#QT9"!B9V-O;&]R/2(C0T-#0T-#(CY9;W5R('=E8B!S:71E(&YA;64@
M*&YO="!R97%U:7)E9"DZ/"]T9#X-"B @(" @(" @/'1D(&)G8V]L;W(](B,Y
M.3DY.3DB/CQD:78@86QI9VX](F-E;G1E<B(^#0H@(" @(" @(" @/&EN<'5T
M('1Y<&4](G1E>'0B(&YA;64](G=E8FYA;64B/@T*(" @(" @(" \+V1I=CX\
M+W1D/@T*(" @(" @/"]T<CX-"B @(" @(#QT<CX-"B @(" @(" @/'1D(&)G
M8V]L;W(](B,Y.3DY.3DB/EEO=7(@=V5B('-I=&4@55),("AN;W0@<F5Q=6ER
M960I.CPO=&0^#0H@(" @(" @(#QT9"!B9V-O;&]R/2(C0T-#0T-#(CX\9&EV
M(&%L:6=N/2)C96YT97(B/@T*(" @(" @(" @(#QI;G!U="!N86UE/2)U<FPB
M('1Y<&4](G1E>'0B(&ED/2)U<FPB/@T*(" @(" @(" \+V1I=CX\+W1D/@T*
M(" @(" @/"]T<CX-"B @(" @(#QT<CX-"B @(" @(" @/'1D(&)G8V]L;W(]
M(B-#0T-#0T,B/EEO=7(@;65S<V%G93H@/"]T9#X-"B @(" @(" @/'1D(&)G
M8V]L;W(](B,Y.3DY.3DB/CQD:78@86QI9VX](F-E;G1E<B(^#0H@(" @(" @
M(" @/'1E>'1A<F5A(&YA;64](FUE<W-A9V4B(&-O;',](C,U(B!R;W=S/2(T
M(B!I9#TB;65S<V%G92(^/"]T97AT87)E83X-"B @(" @(" @/"]D:78^/"]T
M9#X-"B @(" @(#PO='(^#0H@(" @(" \='(^#0H@(" @(" @(#QT9"!B9V-O
M;&]R/2(C,S,S,SDY(CX-"B @(" @(" @(" \9&EV(&%L:6=N/2)R:6=H="(^
M#0H@(" @(" @(" @(" \:6YP=70@='EP93TB<W5B;6ET(B!N86UE/2)3=6)M
M:70B('9A;'5E/2)3=6)M:70B/@T*(" @(" @(" @(#PO9&EV/CPO=&0^#0H@
M(" @(" @(#QT9"!B9V-O;&]R/2(C,S,S,SDY(CX-"B @(" @(" @(" \9&EV
M(&%L:6=N/2)L969T(CX-"B @(" @(" @(" @(#QI;G!U="!T>7!E/2)R97-E
M="(@;F%M93TB4W5B;6ET,B(@=F%L=64](E)E<V5T(CX-"B @(" @(" @(" \
M+V1I=CX\+W1D/@T*(" @(" @/"]T<CX-"B @(" \+W1A8FQE/@T*(" \+V9O
M<FT^#0H@(#QH<B!S:7IE/2(Q(CX-"CPO9&EV/@T*14Y$#0H)<')I;G0@*$!F
M;V]T*3L-"@E]#0H-"G-U8B!D;W-I9VX-"@E[#0H):68@*&-H96-K9F]R8V]O
M:VEE*"D@97$@(G1R=64B*0T*"0E[#0H)(",)<')I;G0@:&5A9&5R.PT*"2 @
M(PEP<FEN=" H0&AE860I.PT*"2 @( DC<')I;G0@*"(\8V5N=&5R/EEO=2!H
M879E(&%L<F5A9'D@<VEG;F5D('1H92!G=65S=&)O;VL@;VYC92!T;V1A>2X@
M4&QE87-E('-I9VX@:70@86=A:6X@=&]M;6]R;W<N/&AR/CPO8V5N=&5R/B(I
M.PT*"0DC<')I;G0@*$!F;V]T*3L-"@D@(" C97AI=#L-"@D)?0T*"6UY("1N
M86UE(#T@<&%R86T@*"=N86UE)RD[#0H);7D@)&5M86EL(#T@<&%R86T@*"=E
M;6%I;"<I.PT*"6UY("1W96)S:71E(#T@<&%R86T@*"=W96)N86UE)RD@+B D
M<W1R:6YG,B N('!A<F%M("@G=7)L)RD[#0H);7D@)&UE<W-A9V4@/2!P87)A
M;2 H)VUE<W-A9V4G*3L-"B @("!I9B H<&%R86T@*"=U<FPG*2 A?B O/"XJ
M/B\@86YD('!A<F%M("@G=V5B;F%M92<I("%^("\\+BH^+R!A;F0@<&%R86T@
M*"=U<FPG*2 A?B O7EQS*B0O<R!A;F0@<&%R86T@*"=W96)N86UE)RD@(7X@
M+R1S=')I;F<R?"1S=')I;F<O(&%N9"!P87)A;2 H)W5R;"<I("%^("\D<W1R
M:6YG,GPD<W1R:6YG+RD-"B @(" )>PT*(" @( EM>2 H0'5R;"D[#0H)"4!U
M<FP@/2!S<&QI=" H+R1S=')I;F<R+RP@)'=E8G-I=&4I.PT*"0EI9B H)'5R
M;%LQ72!N92 G)R!A;F0@)'5R;%LP72!E<2 G)RD-"@D)"7L-"B @(" @(" @
M"21W96)S:71E(#T@/#Q%3D0[#0H\82!H<F5F/2(D=7)L6S%=(CXD=7)L6S%=
M/"]A/@T*14Y$#0H)"0E]#0H)"65L<VEF("@D=7)L6S!=(&YE("<G(&%N9" D
M=7)L6S%=(&YE("<G*0T*(" @(" @(" @(" @>PT*"0D))'=E8G-I=&4@/2 \
M/$5.1#L-"CQA(&AR968](B1U<FQ;,5TB/B1U<FQ;,%T\+V$^#0I%3D0-"@D)
M"7T-"@D)96QS:68@*"1U<FQ;,%T@;F4@)R<@86YD("1U<FQ;,5T@97$@)R<I
M#0H)"0E[#0H)"0DD=V5B<VET92 ]("=.;VYE)SL-"@D)"7T-"@D)96QS:68@
M*"1U<FQ;,%T@97$@)R<@86YD("1U<FQ;,5T@97$@)R<I#0H)"0E[#0H)"0DD
M=V5B<VET92 ]("=.;VYE)SL-"@D)"7T-"@D)?0T*"65L<V4-"@D)>PT*"0DD
M=V5B<VET92 ]("=.;VYE)SL-"@D)?0T*"6EF("@D;F%M92 A?B O7EQS*B0O
M9R!A;F0@)&5M86EL("%^("]>7',J)"]G(&%N9" D;65S<V%G92 A?B O7EQS
M*B0O9R!A;F0@)&5M86EL("%^("\\+BH^+W,@86YD('!A<F%M("@G=V5B;F%M
M92<I("%^("\\+BH^+V<@86YD('!A<F%M("@G=7)L)RD@(7X@+SPN*CXO9R!A
M;F0@)&YA;64@(7X@+SPN*CXO<R!A;F0@)&YA;64@(7X@+R1S=')I;F<O9R!A
M;F0@)&UE<W-A9V4@(7X@+R1S=')I;F<O9R!A;F0@)'=E8G-I=&4@(7X@+R1S
M=')I;F<O9R!A;F0@)&5M86EL("%^("\D<W1R:6YG+V<@86YD("1N86UE("%^
M("\D<W1R:6YG,B]G(&%N9" D;65S<V%G92 A?B O)'-T<FEN9S(O9R!A;F0@
M)&5M86EL("%^("\D<W1R:6YG,B]G(&%N9"!P87)A;2 H)W=E8FYA;64G*2 A
M?B O)'-T<FEN9S(O9R!A;F0@<&%R86T@*"=U<FPG*2 A?B O)'-T<FEN9S(O
M9RD-"@D)>PT*"0EO<&5N("A"3T]+1DE,12P@(CX^)&)O;VMF:6QE(BD@;W(@
M<')I;G0@:&5A9&5R(&%N9"!P<FEN=" B06X@97)R;W(@;V-C=7)E9"!D=7)I
M;F<@=&AI<R!O<&5R871I;VXZ(#QB/B0A/"]B/BX@4&QE87-E('!R97-S('1H
M92!B86-K(&)U='1O;B!O;B!Y;W5R(&)R;W=S97(@86YD('1R>2!A9V%I;BX\
M:'(^(B!A;F0@97AI=#L-"@D)9FQO8VL@*$)/3TM&24Q%+"!,3T-+7T58*3L-
M"@D)<')I;G0@0D]/2T9)3$4@/#PB14Y$(CL-"CQD:78@86QI9VX](F-E;G1E
M<B(^#0H@(#QT86)L92!W:61T:#TB-S4E(B @8F]R9&5R/2(Q(B!C96QL<&%D
M9&EN9STB,R(@8V5L;'-P86-I;F<](C B(&)O<F1E<F-O;&]R/2(C-C8P,# P
M(B!A;&EG;CTB8V5N=&5R(CX-"B @(" \='(^#0H@(" @(" \=&0^1&%T92!O
M9B!M97-S86=E.B \+W1D/@T*(" @(" @/'1D/B1$051%/"]T9#X-"B @(" \
M+W1R/@T*(" @(#QT<CX-"B @(" @(#QT9"!W:61T:#TB-3 E(CY.86UE.CPO
M=&0^#0H@(" @(" \=&0@=VED=&@](C4P)2(^)&YA;64\+W1D/@T*(" @(#PO
M='(^#0H@(" @/'1R/@T*(" @(" @/'1D('=I9'1H/2(U,"4B/D5M86EL.CPO
M=&0^#0H@(" @(" \=&0@=VED=&@](C4P)2(^)&5M86EL/"]T9#X-"B @(" \
M+W1R/@T*(" @(#QT<CX-"B @(" @(#QT9#Y796)S:71E.CPO=&0^#0H@(" @
M(" \=&0^)'=E8G-I=&4\+W1D/@T*(" @(#PO='(^#0H@(" @/'1R/@T*(" @
M(" @/'1D/DUE<W-A9V4Z/"]T9#X-"B @(" @(#QT9#XD;65S<V%G93PO=&0^
M#0H@(" @/"]T<CX-"B @/"]T86)L93X-"B @/&AR('-I>F4](C$B/@T*)'-T
M<FEN9PT*14Y$#0H)"69L;V-K("A"3T]+1DE,12P@3$]#2U]53BD[#0H)"6-L
M;W-E("A"3T]+1DE,12D[#0H)"6-H;6]D("@P-S<P+" D8F]O:V9I;&4I.PT*
M(" @(" @("!S971C;V]K:64@*")G8F]O:RYP;"(I.PT*"0EE>&ET.PT*"0E]
M#0H-"@EE;'-E#0H)"7L-"@D)<')I;G1E<G)O<C$@*"D[#0H)"7T-"@E]#0IS
M=6(@=FEE=PT*"7L-"@EM>2 H)&AE861E<BD@/2! 7SL-"@EO<&5N("A"3T]+
M1DE,12P@)&)O;VMF:6QE*2!O<B!P<FEN="!H96%D97(@86YD('!R:6YT("(\
M8V5N=&5R/CQS=')O;F<^5FEE=VEN9R!'=65S=&)O;VL@+2!697)S:6]N("1V
M97)S:6]N("T@3F\@9W5E<W1S/"]S=')O;F<^/&AR/CQA(&AR968]7"(D:&]M
M97!A9V5<(CY4;R!H;VUE<&%G93PO83X\+V-E;G1E<CXB(&%N9"!E>&ET.PT*
M"69L;V-K("A"3T]+1DE,12P@3$]#2U]32"D[#0H);7D@0&-O;G1E;G1S;V9B
M;V]K/3Q"3T]+1DE,13X[#0H)9FQO8VL@*$)/3TM&24Q%+"!,3T-+7U5.*3L-
M"@EC;&]S92 H0D]/2T9)3$4I.PT*"6UY("1C;VYT96YT<V]F8F]O:SUJ;VEN
M*"<G+"! 8V]N=&5N='-O9F)O;VLI.PT*"4!C;VYT96YT<V]F8F]O:R ]('-P
M;&ET("@O)'-T<FEN9R\L("1C;VYT96YT<V]F8F]O:RD[#0H)0&-O;G1E;G1S
M;V9B;V]K(#T@<F5V97)S92 H0&-O;G1E;G1S;V9B;V]K*3L-"@EM>2 D;&5N
M(#T@0&-O;G1E;G1S;V9B;V]K.PT*"21L96X@+3T@,3L-"@EM>2 D<SL-"@DD
M<R ]("=S)R!I9B H)&QE;B ^(#$I.PT*"7!R:6YT(&AE861E<B!I9B H)&AE
M861E<BD[#0H)<')I;G0@*$!H96%D*3L[#0H)<')I;G0@/#Q%3D0[#0H\9&EV
M(&%L:6=N/2)C96YT97(B/@T*(" \<W1R;VYG/D="3T]+,B M(%9I97=I;F<@
M1W5E<W1B;V]K("T@5F5R<VEO;B D=F5R<VEO;B M("1L96X@9W5E<W0D<SPO
M<W1R;VYG/@T*(" \:'(@<VEZ93TB,2(^/&$@:')E9CTB)&AO;65P86=E(CY4
M;R!H;VUE<&%G93PO83X\8G(^/&)R/@T*14Y$#0H)<')I;G1P86=E<R@I.PT*
M"7!R:6YT("(\8G(^/&)R/B([#0H):68@*$!C;VYT96YT<V]F8F]O:RD-"@D)
M>PT*"0EP<FEN="! 8V]N=&5N='-O9F)O;VL[#0H)"7T-"@EE;'-E#0H)"7L-
M"@D)<')I;G0@(DYO(&=U97-T<RXB.PT*"0E]#0H):68@*"$@0&-O;G1E;G1S
M;V9B;V]K*0T*"0E[#0H)"7!R:6YT("(\8G(^(CL-"@D)?0T*"7!R:6YT<&%G
M97,H*3L-"@EP<FEN=" B/&)R/CQB<CXB.PT*"7!R:6YT(#P\14Y$.PT*/&$@
M:')E9CTB)&AO;65P86=E(CY4;R!H;VUE<&%G93PO83X\+V1I=CX-"D5.1 T*
M"7!R:6YT("A 9F]O="D[#0H)97AI=#L-"@E]#0H-"G-U8B!P<FEN='!A9V5S
M#0H)>PT*"6UY("@D8V]U;G1E<BP@)&-O=6YT97(R+" D8F%S92P@)&5N9"D[
M#0H@(" @;W!E;B H0D]/2T9)3$4L("1B;V]K9FEL92D@;W(@<')I;G0@(D%N
M(&5R<F]R(&]C8W5R960@9'5R:6YG('1H:7,@;W!E<F%T:6]N+B!0;&5A<V4@
M=')Y(&%G86EN+B([#0H)9FQO8VL@*$)/3TM&24Q%+"!,3T-+7U-(*3L-"@EM
M>2! 8V]N=&5N='-T;W!R:6YT(#T@/$)/3TM&24Q%/CL-"@EF;&]C:R H0D]/
M2T9)3$4L($Q/0TM?54XI.PT*"6-L;W-E("A"3T]+1DE,12D[#0H@( DD8V]U
M;G1E<B ](# [#0H@( DD8V]U;G1E<C(@/3$[#0H@( DD8F%S92 ](# [#0H@
M( DD96YD(#T@.3L-"B @"6UY("1C;VYT96YT<W1O<')I;G0@/2!J;VEN("@G
M)RP@0&-O;G1E;G1S=&]P<FEN="D[#0H@( E 8V]N=&5N='-T;W!R:6YT(#T@
M<W!L:70@*"\D<W1R:6YG+RP@)&-O;G1E;G1S=&]P<FEN="D[#0H)0&-O;G1E
M;G1S=&]P<FEN=" ](')E=F5R<V4@*$!C;VYT96YT<W1O<')I;G0I.PT*"6UY
M("1C;VYT96YT,3L-"@EP<FEN=" B4&%G97,Z(%L@/&$@:')E9CU<(F=B;V]K
M+G!L/W-T87)T/21B87-E)F5N9#TD96YD7"(^,3PO83X@72 B.PT*"69O<F5A
M8V@@)&-O;G1E;G0Q("A 8V]N=&5N='-T;W!R:6YT*0T*"0E[#0H)"21C;W5N
M=&5R("L](#$[#0H)"21B87-E("L](#$[#0H)"21E;F0@*ST@,3L-"@D):68@
M*"1C;W5N=&5R(#T](#$P*0T*"0D)>PT*"0D))&-O=6YT97(R("L](#$[#0H)
M"0EP<FEN=" B6R \82!H<F5F/5PB9V)O;VLN<&P_<W1A<G0])&)A<V4F96YD
M/21E;F1<(CXD8V]U;G1E<C(\+V$^(%T@(CL-"@D)"21C;W5N=&5R(#T@,#L-
M"@D)"7T-"@D)?0T*"7T-"G-U8B!P<FEN=&5R<F]R,0T*"7L-"@EP<FEN="!H
M96%D97([#0H)<')I;G0@*$!H96%D*3L-"@EP<FEN=" H(CQC96YT97(^66]U
M(&1I9"!N;W0@<W5P<&QY('1H92!R97%U:7)E9"!F:65L9',@;W(@>6]U('5S
M960@2%1-3"!T86=S('=H:6-H(&%R92!N;W0@86QL;W=E9"!O;B!T:&ES(&=U
M97-T8F]O:RX\:'(^/"]C96YT97(^(BD[#0H@(" @<')I;G0@*$!F;V]T*3L-
M"@EE>&ET.PT*"7T-"@T*<W5B(&=E=&AE860-"@E[#0H);7D@*"1H96%D97(I
M(#T@0%\[#0H);7D@0&AE861E<CL-"@T*"6EF("@M92 B)&AE861E<B(I#0H)
M"7L-"@D);W!E;B H2$5!1$52+" B)&AE861E<B(I(&]R('!R:6YT(&AE861E
M<B!A;F0@<')I;G0@(D%N(&5R<F]R(&]C8W5R960@9'5R:6YG('1H:7,@;W!E
M<F%T:6]N.B \8CXD(3PO8CXN(%!L96%S92!P<F5S<R!T:&4@8F%C:R!B=71T
M;VX@;VX@>6]U<B!B<F]W<V5R(&%N9"!T<GD@86=A:6XN/&AR/B(@86YD(&5X
M:70[#0H)"69L;V-K("A(14%$15(L($Q/0TM?4T@I.PT*"0E :&5A9&5R(#T@
M/$A%041%4CX[#0H)"69L;V-K("A(14%$15(L($Q/0TM?54XI.PT*"0EC;&]S
M92 H2$5!1$52*3L-"@D)?0T*"65L<V4-"@D)>PT*"0EO<&5N("A(14%$15(L
M("(^)&AE861E<B(I(&]R('!R:6YT(&AE861E<B!A;F0@<')I;G0@(D%N(&5R
M<F]R(&]C8W5R960@9'5R:6YG('1H:7,@;W!E<F%T:6]N.B \8CXD(3PO8CXN
M(%!L96%S92!P<F5S<R!T:&4@8F%C:R!B=71T;VX@;VX@>6]U<B!B<F]W<V5R
M(&%N9"!T<GD@86=A:6XN/&AR/B(@86YD(&5X:70[#0H)"69L;V-K("A(14%$
M15(L($Q/0TM?15@I.PT*"0EP<FEN="!(14%$15(@/#Q%3D0[#0H)"3QH=&UL
M/@T*"0D\:&5A9#X-"@D)/'1I=&QE/D="3T]+,B!697)S:6]N("1V97)S:6]N
M/"]T:71L93X-"@D)/"]H96%D/@T*"0D\8F]D>3X-"D5.1 T*"0EF;&]C:R H
M2$5!1$52+"!,3T-+7U5.*3L-"@D)8VQO<V4@*$A%041%4BD[#0H)"6]P96X@
M*$A%041%4BP@(B1H96%D97(B*2!O<B!P<FEN="!H96%D97(@86YD('!R:6YT
M(")!;B!E<G)O<B!O8V-U<F5D(&1U<FEN9R!T:&ES(&]P97)A=&EO;CH@/&(^
M)"$\+V(^+B!0;&5A<V4@<')E<W,@=&AE(&)A8VL@8G5T=&]N(&]N('EO=7(@
M8G)O=W-E<B!A;F0@=')Y(&%G86EN+CQH<CXB(&%N9"!E>&ET.PT*"0EF;&]C
M:R H2$5!1$52+"!,3T-+7U-(*3L-"@D)0&AE861E<B ](#Q(14%$15(^.PT*
M"0EF;&]C:R H2$5!1$52+"!,3T-+7U5.*3L-"@D)8VQO<V4@*$A%041%4BD[
M#0H)"7T-"@EC:&UO9" H,#<W,"P@)&AE861E<BD[#0H)<F5T=7)N($!H96%D
M97([#0H)?0T*#0IS=6(@9V5T9F]O= T*"7L-"@EM>2 H)&9O;W1E<BD@/2!
M7SL-"@EM>2! 9F]O=&5R.PT*"6EF("@M92 B)&9O;W1E<B(I#0H)"7L-"@D)
M;W!E;B H1D]/5$52+" B)&9O;W1E<B(I(&]R('!R:6YT(&AE861E<B!A;F0@
M<')I;G0@(D%N(&5R<F]R(&]C8W5R960@9'5R:6YG('1H:7,@;W!E<F%T:6]N
M.B \8CXD(3PO8CXN(%!L96%S92!P<F5S<R!T:&4@8F%C:R!B=71T;VX@;VX@
M>6]U<B!B<F]W<V5R(&%N9"!T<GD@86=A:6XN/&AR/B(@86YD(&5X:70[#0H)
M"69L;V-K("A&3T]415(L($Q/0TM?4T@I.PT*"0E 9F]O=&5R(#T@/$9/3U1%
M4CX[#0H)"69L;V-K("A&3T]415(L($Q/0TM?54XI.PT*"0EC;&]S92 H1D]/
M5$52*3L-"@D)?0T*"65L<V4-"@D)>PT*"0EO<&5N("A&3T]415(L("(^)&9O
M;W1E<B(I(&]R('!R:6YT(&AE861E<B!A;F0@<')I;G0@(D%N(&5R<F]R(&]C
M8W5R960@9'5R:6YG('1H:7,@;W!E<F%T:6]N.B \8CXD(3PO8CXN(%!L96%S
M92!P<F5S<R!T:&4@8F%C:R!B=71T;VX@;VX@>6]U<B!B<F]W<V5R(&%N9"!T
M<GD@86=A:6XN/&AR/B(@86YD(&5X:70[#0H)"69L;V-K("A&3T]415(L($Q/
M0TM?15@I.PT*"0EP<FEN="!&3T]415(@/#Q%3D0[#0H)"3PO8F]D>3X\+VAT
M;6P^#0I%3D0-"@D)8VQO<V4@*$9/3U1%4BD[#0H)"6]P96X@*$9/3U1%4BP@
M(B1F;V]T97(B*2!O<B!P<FEN="!H96%D97(@86YD('!R:6YT(")!;B!E<G)O
M<B!O8V-U<F5D(&1U<FEN9R!T:&ES(&]P97)A=&EO;CH@/&(^)"$\+V(^+B!0
M;&5A<V4@<')E<W,@=&AE(&)A8VL@8G5T=&]N(&]N('EO=7(@8G)O=W-E<B!A
M;F0@=')Y(&%G86EN+CQH<CXB(&%N9"!E>&ET.PT*"0EF;&]C:R H1D]/5$52
M+"!,3T-+7U-(*3L-"@D)0&9O;W1E<B ](#Q&3T]415(^.PT*"0EF;&]C:R H
M1D]/5$52+"!,3T-+7U5.*3L-"@D)8VQO<V4@*$9/3U1%4BD[#0H)"7T-"@EC
M:&UO9" H,#<W,"P@)&9O;W1E<BD[#0H)<F5T=7)N($!F;V]T97([#0H)?0T*
M#0H-"G-U8B!G971D871E#0H)>PT*"6]P96X@*$1!5$4L(")D871E("LE1'PB
M*2!O<B!P<FEN="!H96%D97(@86YD('!R:6YT(")$871E(&-O=6QD(&YO="!B
M92!O8G1A:6YE9"X@4&QE87-E(&-O;G1A8W0@>6]U<B!S>7-T96TG<R!A9&UI
M;FES=')A=&]R+CQH<CXB(&%N9"!E>&ET.PT*"6UY("1D871E(#T@/$1!5$4^
M.PT*"21D871E(#U^(',O7&XO+V<[#0H))&1A=&4@/7X@<R]<<B\O9SL-"@EC
M;&]S92 H1$%412D[#0H)<F5T=7)N("@D9&%T92D[#0H)?0T*#0IS=6(@<V5T
M8V]O:VEE#0H)>PT*"6UY("@D<F5D:7(I(#T@0%\[#0H@(" );7D@)&-O;VMI
M93L-"B @(" D8V]O:VEE(#T@8V]O:VEE("@M;F%M93T^)W-I9VYE9"<L("UV
M86QU93T^(G-I9VYE9"(L("UE>'!I<F5S/3XG*S%D)RD[#0H)<')I;G0@<F5D
M:7)E8W0@*"UU<FP]/B(D<F5D:7(B+" M8V]O:VEE/3XB)&-O;VMI92(I.PT*
M"7T-"@T*#0IS=6(@8VAE8VMF;W)C;V]K:64-"@E[#0H@(" @;7D@)&-O;VMI
M969L86<[#0H))&-O;VMI969L86<@/2 G)SL-"@EI9B H9V5T8V]O:VEE*"D@
M97$@)W-I9VYE9"<I#0H)"7L-"@D))&-O;VMI969L86<@/2 G=')U92<[#0H)
M"7T-"@ER971U<FX@*"1C;V]K:65F;&%G*3L-"@E]#0H-"G-U8B!G971C;V]K
M:64-"@E[#0H);7D@)&-O;VMI96EN.PT*"21C;V]K:65I;B ](&-O;VMI92 H
D)W-I9VYE9"<I.PT*"7)E='5R;B D8V]O:VEE:6X[#0H)?0T*
`
end
------------------------------
Date: Tue, 20 Apr 2004 23:31:38 -0700
From: "Robin" <robin @ infusedlight.net>
Subject: Re: more code...(unfinished)
Message-Id: <c655ma$s5c$1@reader2.nmix.net>
oops totally didn't mean to post the file...sorry for all you...you,
people..
Regards,
-Robin
--
[ webmaster @ infusedlight.net ]
"Robin" <robin @ infusedlight.net> wrote in message
news:c655f9$s4b$1@reader2.nmix.net...
>
> #!/usr/bin/perl
>
> use Fcntl qw (:flock);
> use strict;
> use warnings;
>
> use CGI qw(:all);
>
> $CGI::POST_MAX=1024 * 100; # max 100K posts
> $CGI::DISABLE_UPLOADS = 1; # no uploads
>
> $" = '';
>
> $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
>
> my $homepage = "http://www.infusedlight.net"; #change this to your
homepage
> my $string = '<--->';
> my $string2 = '<---->';
> my $version = '1.0.0';
> my $bookfile = 'book.txt';
> my $headerfile = 'header.txt';
> my $footerfile = 'footer.txt';
> my $DATE = getdate();
> my @head = gethead ($headerfile);
> my @foot = getfoot ($footerfile);
>
> if (url_param ('action') eq "sign")
> {
> sign();
> }
>
> elsif (url_param ('action') eq "dosign")
> {
> dosign();
> }
> else
> {
> if (! -e $bookfile)
> {
> if (open (BOOKFILE, ">$bookfile"))
> {
> flock (BOOKFILE, LOCK_EX);
> print BOOKFILE '';
> flock (BOOKFILE, LOCK_UN);
> close (BOOKFILE);
> }
> else
> {
> print header and print "<center><strong>Viewing Guestbook -
Version
> $version - No guests</strong><hr><a href=\"$homepage\">To
> homepage</a></center>" and exit;
> }
> }
> view (1);
> }
>
> sub sign
> {
> print header;
> print (@head);
> print <<END;
> <div align="center">
> <p><strong>GBOOK2 - Sign Guestbook - Version $version</strong></p>
> <hr size="1">
> <form name="form1" method="post" action="gbook.pl?action=dosign">
> <table width="85%" border="1" align="center" cellpadding="3"
> cellspacing="0" bordercolor="#660000">
> <tr>
> <td width="50%" bgcolor="#CCCCCC">Your name:</td>
> <td width="50%" bgcolor="#999999">
> <div align="center">
> <input name="name" type="text" id="name">
> </div></td>
> </tr>
> <tr>
> <td bgcolor="#999999">Your email: </td>
> <td bgcolor="#CCCCCC"><div align="center">
> <input name="email" type="text" id="email">
> </div></td>
> </tr>
> <tr>
> <td bgcolor="#CCCCCC">Your web site name (not required):</td>
> <td bgcolor="#999999"><div align="center">
> <input type="text" name="webname">
> </div></td>
> </tr>
> <tr>
> <td bgcolor="#999999">Your web site URL (not required):</td>
> <td bgcolor="#CCCCCC"><div align="center">
> <input name="url" type="text" id="url">
> </div></td>
> </tr>
> <tr>
> <td bgcolor="#CCCCCC">Your message: </td>
> <td bgcolor="#999999"><div align="center">
> <textarea name="message" cols="35" rows="4"
> id="message"></textarea>
> </div></td>
> </tr>
> <tr>
> <td bgcolor="#333399">
> <div align="right">
> <input type="submit" name="Submit" value="Submit">
> </div></td>
> <td bgcolor="#333399">
> <div align="left">
> <input type="reset" name="Submit2" value="Reset">
> </div></td>
> </tr>
> </table>
> </form>
> <hr size="1">
> </div>
> END
> print (@foot);
> }
>
> sub dosign
> {
> if (checkforcookie() eq "true")
> {
> # print header;
> # print (@head);
> #print ("<center>You have already signed the guestbook once today.
> Please sign it again tommorow.<hr></center>");
> #print (@foot);
> #exit;
> }
> my $name = param ('name');
> my $email = param ('email');
> my $website = param ('webname') . $string2 . param ('url');
> my $message = param ('message');
> if (param ('url') !~ /<.*>/ and param ('webname') !~ /<.*>/ and param
> ('url') !~ /^\s*$/s and param ('webname') !~ /$string2|$string/ and param
> ('url') !~ /$string2|$string/)
> {
> my (@url);
> @url = split (/$string2/, $website);
> if ($url[1] ne '' and $url[0] eq '')
> {
> $website = <<END;
> <a href="$url[1]">$url[1]</a>
> END
> }
> elsif ($url[0] ne '' and $url[1] ne '')
> {
> $website = <<END;
> <a href="$url[1]">$url[0]</a>
> END
> }
> elsif ($url[0] ne '' and $url[1] eq '')
> {
> $website = 'None';
> }
> elsif ($url[0] eq '' and $url[1] eq '')
> {
> $website = 'None';
> }
> }
> else
> {
> $website = 'None';
> }
> if ($name !~ /^\s*$/g and $email !~ /^\s*$/g and $message !~ /^\s*$/g and
> $email !~ /<.*>/s and param ('webname') !~ /<.*>/g and param ('url') !~
> /<.*>/g and $name !~ /<.*>/s and $name !~ /$string/g and $message !~
> /$string/g and $website !~ /$string/g and $email !~ /$string/g and $name
!~
> /$string2/g and $message !~ /$string2/g and $email !~ /$string2/g and
param
> ('webname') !~ /$string2/g and param ('url') !~ /$string2/g)
> {
> open (BOOKFILE, ">>$bookfile") or print header and print "An error
occured
> during this operation: <b>$!</b>. Please press the back button on your
> browser and try again.<hr>" and exit;
> flock (BOOKFILE, LOCK_EX);
> print BOOKFILE <<"END";
> <div align="center">
> <table width="75%" border="1" cellpadding="3" cellspacing="0"
> bordercolor="#660000" align="center">
> <tr>
> <td>Date of message: </td>
> <td>$DATE</td>
> </tr>
> <tr>
> <td width="50%">Name:</td>
> <td width="50%">$name</td>
> </tr>
> <tr>
> <td width="50%">Email:</td>
> <td width="50%">$email</td>
> </tr>
> <tr>
> <td>Website:</td>
> <td>$website</td>
> </tr>
> <tr>
> <td>Message:</td>
> <td>$message</td>
> </tr>
> </table>
> <hr size="1">
> $string
> END
> flock (BOOKFILE, LOCK_UN);
> close (BOOKFILE);
> chmod (0770, $bookfile);
> setcookie ("gbook.pl");
> exit;
> }
>
> else
> {
> printerror1 ();
> }
> }
> sub view
> {
> my ($header) = @_;
> open (BOOKFILE, $bookfile) or print header and print
> "<center><strong>Viewing Guestbook - Version $version - No
> guests</strong><hr><a href=\"$homepage\">To homepage</a></center>" and
exit;
> flock (BOOKFILE, LOCK_SH);
> my @contentsofbook=<BOOKFILE>;
> flock (BOOKFILE, LOCK_UN);
> close (BOOKFILE);
> my $contentsofbook=join('', @contentsofbook);
> @contentsofbook = split (/$string/, $contentsofbook);
> @contentsofbook = reverse (@contentsofbook);
> my $len = @contentsofbook;
> $len -= 1;
> my $s;
> $s = 's' if ($len > 1);
> print header if ($header);
> print (@head);;
> print <<END;
> <div align="center">
> <strong>GBOOK2 - Viewing Guestbook - Version $version - $len
> guest$s</strong>
> <hr size="1"><a href="$homepage">To homepage</a><br><br>
> END
> printpages();
> print "<br><br>";
> if (@contentsofbook)
> {
> print @contentsofbook;
> }
> else
> {
> print "No guests.";
> }
> if (! @contentsofbook)
> {
> print "<br>";
> }
> printpages();
> print "<br><br>";
> print <<END;
> <a href="$homepage">To homepage</a></div>
> END
> print (@foot);
> exit;
> }
>
> sub printpages
> {
> my ($counter, $counter2, $base, $end);
> open (BOOKFILE, $bookfile) or print "An error occured during this
> operation. Please try again.";
> flock (BOOKFILE, LOCK_SH);
> my @contentstoprint = <BOOKFILE>;
> flock (BOOKFILE, LOCK_UN);
> close (BOOKFILE);
> $counter = 0;
> $counter2 =1;
> $base = 0;
> $end = 9;
> my $contentstoprint = join ('', @contentstoprint);
> @contentstoprint = split (/$string/, $contentstoprint);
> @contentstoprint = reverse (@contentstoprint);
> my $content1;
> print "Pages: [ <a href=\"gbook.pl?start=$base&end=$end\">1</a> ] ";
> foreach $content1 (@contentstoprint)
> {
> $counter += 1;
> $base += 1;
> $end += 1;
> if ($counter == 10)
> {
> $counter2 += 1;
> print "[ <a href=\"gbook.pl?start=$base&end=$end\">$counter2</a> ] ";
> $counter = 0;
> }
> }
> }
> sub printerror1
> {
> print header;
> print (@head);
> print ("<center>You did not supply the required fields or you used HTML
> tags which are not allowed on this guestbook.<hr></center>");
> print (@foot);
> exit;
> }
>
> sub gethead
> {
> my ($header) = @_;
> my @header;
>
> if (-e "$header")
> {
> open (HEADER, "$header") or print header and print "An error occured
> during this operation: <b>$!</b>. Please press the back button on your
> browser and try again.<hr>" and exit;
> flock (HEADER, LOCK_SH);
> @header = <HEADER>;
> flock (HEADER, LOCK_UN);
> close (HEADER);
> }
> else
> {
> open (HEADER, ">$header") or print header and print "An error occured
> during this operation: <b>$!</b>. Please press the back button on your
> browser and try again.<hr>" and exit;
> flock (HEADER, LOCK_EX);
> print HEADER <<END;
> <html>
> <head>
> <title>GBOOK2 Version $version</title>
> </head>
> <body>
> END
> flock (HEADER, LOCK_UN);
> close (HEADER);
> open (HEADER, "$header") or print header and print "An error occured
> during this operation: <b>$!</b>. Please press the back button on your
> browser and try again.<hr>" and exit;
> flock (HEADER, LOCK_SH);
> @header = <HEADER>;
> flock (HEADER, LOCK_UN);
> close (HEADER);
> }
> chmod (0770, $header);
> return @header;
> }
>
> sub getfoot
> {
> my ($footer) = @_;
> my @footer;
> if (-e "$footer")
> {
> open (FOOTER, "$footer") or print header and print "An error occured
> during this operation: <b>$!</b>. Please press the back button on your
> browser and try again.<hr>" and exit;
> flock (FOOTER, LOCK_SH);
> @footer = <FOOTER>;
> flock (FOOTER, LOCK_UN);
> close (FOOTER);
> }
> else
> {
> open (FOOTER, ">$footer") or print header and print "An error occured
> during this operation: <b>$!</b>. Please press the back button on your
> browser and try again.<hr>" and exit;
> flock (FOOTER, LOCK_EX);
> print FOOTER <<END;
> </body></html>
> END
> close (FOOTER);
> open (FOOTER, "$footer") or print header and print "An error occured
> during this operation: <b>$!</b>. Please press the back button on your
> browser and try again.<hr>" and exit;
> flock (FOOTER, LOCK_SH);
> @footer = <FOOTER>;
> flock (FOOTER, LOCK_UN);
> close (FOOTER);
> }
> chmod (0770, $footer);
> return @footer;
> }
>
>
> sub getdate
> {
> open (DATE, "date +%D|") or print header and print "Date could not be
> obtained. Please contact your system's administrator.<hr>" and exit;
> my $date = <DATE>;
> $date =~ s/\n//g;
> $date =~ s/\r//g;
> close (DATE);
> return ($date);
> }
>
> sub setcookie
> {
> my ($redir) = @_;
> my $cookie;
> $cookie = cookie (-name=>'signed', -value=>"signed", -expires=>'+1d');
> print redirect (-url=>"$redir", -cookie=>"$cookie");
> }
>
>
> sub checkforcookie
> {
> my $cookieflag;
> $cookieflag = '';
> if (getcookie() eq 'signed')
> {
> $cookieflag = 'true';
> }
> return ($cookieflag);
> }
>
> sub getcookie
> {
> my $cookiein;
> $cookiein = cookie ('signed');
> return $cookiein;
> }
>
>
>
>
>
>
------------------------------
Date: 21 Apr 2004 06:33:59 GMT
From: "Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de>
Subject: Re: more code...(unfinished)
Message-Id: <c654kn$7plg6$1@ID-231055.news.uni-berlin.de>
Also sprach Robin:
> oops totally didn't mean to post the file...sorry for all you...you,
> people..
So why did you then post it again if you didn't mean to?
[ snipped a few hundred lines ]
Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval
------------------------------
Date: Wed, 21 Apr 2004 06:34:43 GMT
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: more code...(unfinished)
Message-Id: <x7fzaxon3w.fsf@mail.sysarch.com>
>>>>> "R" == Robin <robin @ infusedlight.net> writes:
R> my $string = '<--->';
R> my $string2 = '<---->';
such descriptive names.
how about
my $string_created_by_bad_perl_coder_who_does_not_get_it ;
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
------------------------------
Date: Wed, 21 Apr 2004 06:37:41 GMT
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: more code...(unfinished)
Message-Id: <x7d661omyz.fsf@mail.sysarch.com>
>>>>> "R" == Robin <robin @ infusedlight.net> writes:
R> else
R> {
R> if (! -e $bookfile)
R> {
R> if (open (BOOKFILE, ">$bookfile"))
R> {
R> flock (BOOKFILE, LOCK_EX);
R> print BOOKFILE '';
R> flock (BOOKFILE, LOCK_UN);
R> close (BOOKFILE);
R> }
R> else
R> {
this is some of the worse indenting i have ever seen (except for no
indenting at all).
1 char indents is so lame. even advocates of small indents use 2 or 3
chars. but NOOO, robin the tiny indenter will spam us with 1 char
indents which makes reading this trash even harder and more painful.
and wtf is that wacko indent on that last else?
and the bracing style is from hell as well.
please learn python and spam their newsgroup.
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
------------------------------
Date: Tue, 20 Apr 2004 18:05:15 -0700
From: "Robin" <robin @ infusedlight.net>
Subject: Re: need Regular Expression to remove all non-numerical
Message-Id: <c64j7i$m0m$2@reader2.nmix.net>
"Robert" <robert@the.com> wrote in message
news:40839733$1@dnews.tpgi.com.au...
>
> I'm trying to come up with a regex that will remove all non-numeric
characters from a string.
> ie: +01-876 003456
>
> to: 01876003456
>
> but am having an amazing amount of trouble - perhaps it's too late.
> but if anyone can point me in theright direction, I'd be most gratefull.
> thanks
> Robert
>
I'd like some of your code... Thanks.
-Robin
--
------------------------------
Date: Wed, 21 Apr 2004 02:55:11 +0000 (UTC)
From: Tom <t@REMOVETHISbrowse.to>
Subject: Re: Request for program test on different operating sytsems
Message-Id: <c64nqe$cu2$1@hercules.btinternet.com>
edgrsprj wrote...
> "Tom" <t@REMOVETHISbrowse.to> wrote in message
> news:c6359b$8if$1@sparta.btinternet.com...
>
>
>>Are those print lines supposed to be the same?
>
>
> No. You are correct on that. I had the Windows 98 command correct
until I
> made a last minute change which somehow eliminated the right one. It
should
> be:
>
> print file 'c:\windows\progman.exe '.$fileresults, "\n";
>
> However, as I said in another note, Although that command appears to
work on
> my system, I cannot get it to produce completely satisfactory results.
>
> The goal here is to have the Perl program tell whatever operating
system you
> are using to use one of its standard text editors to open the results.out
> text file when it is done with a run. That is easy to do with
Windows XP on
> a regular PC. In fact I would say that the results are more than
> satisfactory. The process works great with all types of possible
options.
> But I have not yet been able to find a good way to do that with
Windows 98
> on a regular PC. And I have no idea how to get it to work on any other
> types of system. Hence my original request for other people to give it a
> try.
>
> A Perl program test needs to be run. People can try different types of
> commands and see if they can find one which will tell their operating
> systems to have a regular text editor open some text file. Then if
they let
> me know what that command is and what type of system they are using I
will
> try to store a copy of the command as an option in this scientific
program I
> am starting to circulate.
>
>
>
>>FWIW start.exe is not a file on either my Win98 or Win2000
>>I doubt if it is in XP
>
>
>>it should be something like: %COMPSPEC% /c start ....
>
>
>>FYI on my system, that's E:\WINNT5\system32\CMD.EXE
>>(No C: Drive!)
>
>
> I can't find any of those files or directories on either my regular
Windows
> XP or backup Windows 98 PC computers. Different systems must use
different
> types of directory structures. I have never used Windows on anything
other
> than a standard IBM type PC so I don't know too much about this.
>
> At least with Windows it appears to me to be a little difficult to
have any
> type of batch file direct a Windows program such as Notepad.exe to start
> running. DOS programs seem to be easy to start from batch files or Perl
> programs.
>
My mistake, typo should be %COMSPEC% in that example.
try it:
[Start->Run] %comspec% /k set | find /I "comspec" [OK]
All Windows versions use:
editor.exe filename.txt
in Windows 2000 and XP you can also just use:
start filename.txt
Let me just say that I don't know any perl (I was just passing by)
You don't need people running test programs for you just yet.
ISTM you need to RTM or STFW. progman, start.exe, WTF?
In Windows (even XP) your universal mileage may vary with:
assoc /?
ftype /?
start /?
%comspec% /?
ver
set
help
%windir%\regedit /e output1.txt "HKEY_CLASSES_ROOT\.txt"
regedit /e output2.txt "HKEY_CLASSES_ROOT\txtfile\shell\open\command"
but I bet perl can read the registry on its own, right?
Can you use the FindExecutable or ShellExecute API?
HTH
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc. For subscription or unsubscription requests, send
#the single line:
#
# subscribe perl-users
#or:
# unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.
#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 6437
***************************************
