[19143] in Perl-Users-Digest
Perl-Users Digest, Issue: 1338 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Jul 19 21:05:49 2001
Date: Thu, 19 Jul 2001 18:05:10 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <995591110-v10-i1338@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Thu, 19 Jul 2001 Volume: 10 Number: 1338
Today's topics:
Re: (long spam) advice needed: how robust spam is this <godzilla@stomp.stomp.tokyo>
(long) advice needed: how robust is this script ? and o (Kev)
Re: Academic exercise - string/variable interpolation f (Craig Berry)
Re: Academic exercise - string/variable interpolation f (Jay Tilton)
Re: Academic exercise - string/variable interpolation f <krahnj@acm.org>
Re: Any perl module for XML Explorer tree display/edit? <slaven.rezic@berlin.de>
Re: don't laugh <carlos@plant.student.utwente.nl>
FAQ: How can I compile Perl into Java? <faq@denver.pm.org>
Re: FAQ: Is it unsafe to return a pointer to local data <iltzu@sci.invalid>
Re: Generic Language interpreter in Perl? <bart.lateur@skynet.be>
Re: GnuPG encrypting from STDIN in CGI <Juha.Laiho@iki.fi>
Re: How to run Perl on MS-DOS (Tim Hammerquist)
Re: ide for perl? <rsherman@ce.gatech.edu>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 19 Jul 2001 16:47:54 -0700
From: "Godzilla!" <godzilla@stomp.stomp.tokyo>
Subject: Re: (long spam) advice needed: how robust spam is this script ? and other spam questions :)
Message-Id: <3B5771AA.24A82573@stomp.stomp.tokyo>
Kev wrote:
(snipped over one-thousand lines of code spam)
> My questions are the following:
> 1. Is this script robust...
After a quick glance at those one-thousand plus lines
of code spam, it is readily apparent this script could
be easily hacked by a kRAd KewL Dudz sCript KiDDie
resulting in your server's primary hard drive being
sucked up then emailed to steve.case@aol.com with no
attachment needed.
Godzilla! Queen Of Robust Butts.
--
print "Code Spam Troll " x 10**1000000;
------------------------------
Date: Fri, 20 Jul 2001 01:06:28 GMT
From: NOSPAMlekkerinsydney@ozemail.com.au (Kev)
Subject: (long) advice needed: how robust is this script ? and other questions :)
Message-Id: <3b5783f0.1173336306@news.ozemail.com.au>
Hi All
I am new to perl, and request the advice /
assistance of you seasoned pro's.
Any assistance very gratefully appreciated.
We obtained a free script off the web that is used
to "recommend a site to a friend".
I have managed to modify it so it is appropriate
for an html "viral" marketing campaign where
people can forward the email (in reality they will
be forwarding a web page via email) to other
people.
My questions are the following:
1. Is this script robust so that
10?100?1000?10000? people accessing it at the same
tiime wouldn't have a probem using the script ?
2. Do I have to employ "flock" anywhere in the
script ?
3. How does one go about testing the "strength" of
these scripts ? In theory I would like 1000 people
to use the script at the same time to see how it
goes. Is there anyway of creating a test
environment ?
4. The script seems to be slow. Is there anyway
of "speeding" it up ?
5. Any other advice you folk think I need !
I have included the script here for reference
purposes.
Any assistance appreciated. Feel free to post
responses here or to email me direct (remove the
NOSPAM bit)
Thanks in advance for your help.
Kev
!/usr/local/bin/perl
#
# ------- Begin: header information and
copyright notice -------
#
# MasterRecommend
# Version 1.3 for NT with BLAT
# Copyright (c) 1998 by William Bontrager.
All rights reserved.
# Version 1.0 completed April 13, 1998
# Version 1.1 completed June 11, 1998. Fixed
bug with %ENV{DOCUMENT_ROOT} being
# unusable on a few internet hosts.
# Version 1.2 completed June 16, 1998.
Patched code to make it harder for someone
# to spam/blast using MasterRecommend.
# Version 1.3 completed January 8, 1999.
Ported to NT for BLAT with help from
# Chris, Web Admin. at The Times OnLine
http://www.mindentimes.on.ca
# Author: William Bontrager
# Author's E-mail: william@willmaster.com
# Author's Website:
http://www.willmaster.com/
#
# MasterRecommend is designed to make it easy
for visitors to your website to
# recommend your site to their friends and
acquaintances. I tried to make
# it as easy as possible to customize
MasterRecommend to your particular
# requirements.
# It is designed to accept information from a
web page form with either POST
# or GET. And it is designed to minimize
intentional and unintentional misuse,
# including spamming and/or blasing.
# It is designed to be executed with Perl 5;
it won't work with versions prior to 5.
# MasterRecommend is also designed to flag
some possibly offensive terms and, in
# such instance, will refuse to forward the
recommendation. Instead, it will
# send a special message to the web site
maintainer with a copy of the message
# and notice that the message was not
delivered. The author of MasterRecommend
# realizes that the "offensive terms"
algorithm can never be all things to
# all societies and sensibilities.
Suggestions for additions and/or deletions
# are welcome.
#
# COPYRIGHT NOTICE
# Copyright (c) 1998 by William Bontrager.
All rights reserved.
#
# MasterRecommend may be used and modified
free of charge by anyone so long as
# this header information and copyright
notice remain intact. By using and/or
# modifying MasterRecommend you agree to
indemnify William Bontrager and his
# associates from any liability that might
arise from its use and/or modification.
#
# Selling the code for MasterRecommend
without prior written consent from the
# copyright owner is expressly forbidden. You
must have permission before
# redistributing MasterRecommend. In all
cases, this header information and
# copyright notice must remain intact and the
accompanying README file must
# be readily available.
#
# ------- End: header information and
copyright notice -------
#
#===============================
#
# ------- Begin: customizing actions
-------
#
# NOTE: It is recommended that you read the
README file for MasterRecommend
# before proceeding.
#
# There are 3 items that need to be changed
or verified correct:
# (1) The location of Perl 5 on your system
# (2) The location and name of the mail
program on your server's system
# (3) The domain, folder, and/or the file
name where
# your "recommend" form resides
#
# We'll do these in order:
#
# (1) The location of Perl 5 on your system
#
# The first line of this file, all the way at
the top, must contain the location
# of Perl 5 on your system. The line begins
with "#!" (without the quotes) and
# ends with the location (no white space).
#
# (2) The location and name of the mail
program on your server's system
#
# Modify the line below to reflect the
location and name of your mail program. It
# must be assigned to the variable
$MailProgram.
$MailProgram = 'E:\\Blat\\Blat.exe';
$TempMailFile1 =
'e:xxxx';
$TempMailFile2 =
'e:xxxx';
$TempMailFile3 =
'e:xxxx';
$TempMailFile5 =
'e:xxx
';
# (3) The domain, folder, and/or the file
name where your "recommend" form resides
#
# If you want some protection to keep your
program from being used to
# spam/flame/blast people, the line below
(the one that begins with
# "@users =" (without the quotes)) can be
used to list the domain
# name and/or number where your
MasterRecommend form is located. You may
# include directories/folders and file
names if you wish.
#
# The list may be as long or as short as you
wish it to be. Just keep each entry
# within its own set of single quotes. And
the entries must be separated with
# a comma.
#
# If you do not desire the protection, either
delete the following line or
# comment it out with a # at the beginning
of the line.
# @users = ('willmaster.com','192.41.1.10');
#
# That's it. Just upload this program, your
web page, and the file with your
# e-mail text. You're ready to test 'n go!
#
# NOTE: On some systems, you may be required
to rename MasterRecommend with
# a .cgi extension. Check with your system
administrator.
#
# On UNIX systems, the file permissions must
be set correctly.
# CHMOD MasterRecommend to 755. That
translates to
# read/write/execute - read/execute -
read/execute
#
# NOTE: Be sure to upload MasterRecommend as
an ASCII text file rather than as
# a binary file.
#
# NOTE: See the README file for other
information related to uploading.
#
# ------- End: customizing actions
-------
#
#===============================
#
# ------- Begin: form fields
discussion -------
#
# Here is a list of fields supported by
MasterRecommend:
#
# *** Hidden fields (required)
# Field Name: Contents of Field:
# maintainername The name
of the person
maintaining the webpage
# maintainermail
Maintainer's e-mail
address
# sitename The name
or title of your site
# siteurl The URL of
your site
#
# *** Hidden fields (optional)
# Field Name: Contents of Field:
# template Location
and name of file
containing the subject
#
and body of the e-mail text
# visitorgetsmail Are you
sending
acknowledgment e-mail to the visitor?
#
Use "yes", "y", or "1" (one) for
positive answer
#
Use "no", "n", or "0" (zero) for
negative answer
#
(The above are not case sensitive)
# redirecturl The URL the
visitor is sent
to after completing the form
# invalidfieldsurl The URL to present
when
any names or e-mail
#
addresses are missing or invalid
#
# *** Display fields (required)
# Field Name: Contents of Field:
# visitorname Visitor's name
# visitormail Visitor's e-mail
address
# friendname Friend's
name (to whom your
site is recommended)
# friendmail Friend's
e-mail address
#
# *** Display fields (optional)
# Field Name: Contents of Field:
# message A text
area for Visitor to write
a note to Friend
# sendcopy Checkbox
if Visitor wants a
copy of e-mail sent to Friend
#
# *** Button (required)
# Field Name: Contents of Field:
# submit Visitor
clicks on this button to
submit the recommendation
#
# *** Button (optional)
# Field Name: Contents of Field:
# reset Visitor
clicks this button to
clear the form
#
# ------- End: form fields discussion
-------
#
#===============================
#
# ------- Begin: program variables
discussion -------
#
# The data submitted from the form is stored
in this associative (hash) array:
%InboundData;
# The system date and time are stored in
these scalar variables:
$Date;
$Time;
# The result of the "offensive terms" check
on the names, e-mail addresses,
# and message is stored in this salar
variable:
$Offensive;
# The following scalars are used to store the
subject and body text of the
# e-mails to be sent to the visitor, friend,
and maintainer.
$FriendMailSubject;
$FriendMailText;
$VisitorMailSubject;
$VisitorMailText;
$MaintainerMailSubject;
$MaintainerMailText;
# The following scalar is defined in a
previous section:
#
# Name of variable: What is
stored:
# $MailProgram
location and name of mail
program
#
# ------- End: program variables
discussion -------
#
#===============================
#
# ------- Begin: MasterRecommend
program -------
#
# NOTE: All global program variables are
declared in the "customizing actions"
# and "program variables discussion"
sections, above.
# Retrieve the system date and time
&RetrieveDate;
# Parse the data submitted from form
&ParseFormData;
# If used by an unauthorized user, error
message will be given and program exits
&CheckIfAuthorizedUser;
# Check that required fields have been
submitted by the form and do a
# rudimentary check to determine that the
fields contain valid data
&CheckRequiredFields;
# allow maximum of two consecutive linefeeds,
returns, and/or form feeds in message
if(defined($InboundData{message}))
{ $InboundData{message} =~
s/[\r\n\f][\r\n\f][\r\n\f]+/\n\n/g; }
# Check if names, addresses, or message
contain possibly offensive terms
$Offensive =
&CheckForOffensiveTerms($InboundData{visitorn
ame},
$InboundData{visitormail},
$InboundData{friendname},
$InboundData{friendmail},
$InboundData{friendmail2},
$InboundData{friendmail3},
$InboundData{friendmail4},
$InboundData{message});
# Assign subject and body of e-mails to
appropriate global variables
&GetEMailText;
# If using sendmail, add the -t option to the
mail program name
if($MailProgram =~ /\/sendmail\Z/)
{ $MailProgram .= ' -t'; }
# If appropriate, send e-mail to the person
the website was recommended to
if(! $Offensive) { &SendFriendMail; }
if(! $Offensive) { &SendFriendMail2; }
if(! $Offensive) { &SendFriendMail3; }
if(! $Offensive) { &SendFriendMail4; }
# If appropriate, send e-mail to the visitor
if( (
(defined($InboundData{'visitorgetsmail'})) &&
($InboundData{'visitorgetsmail'} =~
/^[yY1l]|^ *[yY1l]/) )
||
( (defined($InboundData{'sendcopy'})) &&
($InboundData{'sendcopy'} =~ /^[yY1l]|^
*[yY1l]/) ) )
{ if(! $Offensive) { &SendVisitorMail; } }
# Send e-mail to the maintainer
&SendMaintainerMail;
# Give visitor an acknowledgment via her/his
browser
if(defined($InboundData{'redirecturl'}))
{ print "Location:
$InboundData{'redirecturl'}\n\n"; }
else
{ &ThankYouHTML; }
exit;
# sub: Retrieve the system date and time
sub RetrieveDate
{
my @months =
("January","February","March","April","May","
June","July","August","September","October","
November","December");
my @weekdays =
("Sunday","Monday","Tuesday","Wednesday","Thu
rsday","Friday","Saturday");
my
($sec,$min,$hour,$mday,$month,$year,$wday,$yd
ay,$dst) = localtime(time);
$Time = "$hour\:$min\:$sec";
if ($year < 98) { $year += 2000; }
else { $year += 1900; }
$Date = "$weekdays[$wday], $months[$month]
$mday, $year";
} # sub RetrieveDate
# sub: Parse the data submitted from form
sub ParseFormData
{
my @pairs;
my $buffer;
# Accept the submitted data. If the
REQUEST_METHOD was not GET or POST,
# send an error page to the browser.
if ($ENV{'REQUEST_METHOD'} eq 'GET')
{ @pairs = split(/&/,
$ENV{'QUERY_STRING'}); }
elsif ($ENV{'REQUEST_METHOD'} eq 'POST')
{
read(STDIN, $buffer,
$ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
}
else
{
&ErrorHTML('The form\'s method must be
either POST or GET (all caps)');
exit;
}
# Split and decode @pairs, eliminate
security hazards, and assign
# the results to %InboundData
my ($name,$value);
foreach $t (@pairs)
{
# Split
($name,$value) = split(/=/,$t);
# Decode
$value =~ tr/+/ /;
$value =~
s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))
/eg;
# Eliminate any possibly hazardous server
side includes
$value =~ s/<!--//g;
# Eliminate any possibly hazardous
subshells
$value =~ s/~!/ ~!/g;
# Assign result to %InboundData
$InboundData{$name} = $value;
}
} # sub ParseFormData
# sub: Check if the form is sent from an
authorized domain. If
# $ENV{'HTTP_REFERER'} is null, @users does
not exist, or form is from
# an authorized domain, authorize mailing.
Else, notify maintainer
# that unauthorized use has been attempted
and show error message.
sub CheckIfAuthorizedUser
{
if(! $ENV{'HTTP_REFERER'}) { return 1; }
if((! defined(@users)) || (! $users[0])) {
return 1; }
# if(! defined(@users)) { return 1; }
foreach $t (@users)
{
if($ENV{'HTTP_REFERER'} =~ /$t/i)
{ return 1; }
}
open(MAIL,"|$MailProgram");
print MAIL "To:
\"$InboundData{maintainername}\"
\<$InboundData{maintainermail}\>\n";
print MAIL "From:
\"$InboundData{maintainername}\"
\<$InboundData{maintainermail}\>\n";
print MAIL "Subject: Unauthorized use
attempted!\n\n";
print MAIL "Unauthorized use of
MasterRecommend was attempted from
$ENV{'HTTP_REFERER'}\n";
close (MAIL);
ErrorHTML("Sorry, $ENV{'HTTP_REFERER'} is
not on list of authorized form locations");
} # sub CheckIfAuthorizedUser
# sub: Present user with a browser page
informing of an error
sub ErrorHTML
{
my ($ts) = @_;
print "Content-type: text/html\n\n";
print
'<html><head><title>Error!</title></head><bod
y bgcolor="#ffffff" text="#000080"
link="#ff8000" vlink="#8000ff"
alink="#ff8000"><center><h3>';
print $ts;
my $t = &PageAddendum;
print "</h3><hr
width=33\%></center>$t</body></html>\n";
exit;
} # sub ErrorHTML
# sub: Check that required fields have been
submitted by the form
sub CheckRequiredFields
{
# First, check for missing hidden fields
my $errorstring = 'Note: these hidden form
fields are required!<br>';
my $b = 0;
if(!
defined($InboundData{'maintainername'}) )
{
$errorstring .= "<br>maintainername";
$b = 1;
}
if(!
defined($InboundData{'maintainermail'}) )
{
$errorstring .= "<br>maintainermail";
$b = 1;
}
if(! defined($InboundData{'sitename'}) )
{
$errorstring .= "<br>sitename";
$b = 1;
}
if(! defined($InboundData{'siteurl'}) )
{
$errorstring .= "<br>siteurl";
$b = 1;
}
if($b)
{
&ErrorHTML($errorstring);
exit;
}
# Last, check for missing user supplied data
$errorstring = 'Note: The following data is
either missing or invalid:<br>';
$b = 0;
if( (! defined($InboundData{'visitorname'}))
|| (!
&NameValid($InboundData{'visitorname'})) )
{
$errorstring .= "<br>Your Name";
$b = 1;
}
if( (! defined($InboundData{'visitormail'}))
|| (!
&MailValid($InboundData{'visitormail'})) )
{
$errorstring .= "<br>Your E-Mail Address";
$b = 1;
}
if( (! defined($InboundData{'friendname'}))
|| (!
&NameValid($InboundData{'friendname'})) )
{
$errorstring .= "<br>Your Friend's Name";
$b = 1;
}
if( (! defined($InboundData{'friendmail'}))
|| (!
&MailValid($InboundData{'friendmail'})) )
{
}
if( (! defined($InboundData{'friendmail2'}))
|| (!
&MailValid($InboundData{'friendmail2'})) )
{
}
if( (! defined($InboundData{'friendmail3'}))
|| (!
&MailValid($InboundData{'friendmail3'})) )
{
}
if( (! defined($InboundData{'friendmail4'}))
|| (!
&MailValid($InboundData{'friendmail4'})) )
{
$errorstring .= "<br>Your Friend's E-Mail
Address";
$b = 1;
}
if($b)
{
if(defined($InboundData{'invalidfieldsurl'}))
{ print "Location:
$InboundData{'invalidfieldsurl'}\n\n"; }
else
{
$errorstring .= "<br><br>Using the name
\"Anonymous\" is acceptable,<br>but e-mail
addresses must be valid for proper mail
delivery.<br><br>Please use your browser's
\"back\" button and complete the
form.<br><br>Thank You Very Much";
&ErrorHTML($errorstring);
}
exit;
}
} # sub CheckRequiredFields
# sub: Is the name a valid name? (Used in
subroutine CheckRequiredFields)
sub NameValid
{
my ($t) = @_;
if($t =~ /[a-zA-Z]/)
{ return 1; }
return 0;
} # sub NameValid
# sub: Is the e-mail address a valid e-mail
address? (Used in subroutine
# CheckRequiredFields)
sub MailValid
{
my ($t) = @_;
if ($t =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/)
{ return 0; }
if($t !~
/^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[
0-9]{1,3})(\]?)$/)
{ return 0; }
return 1;
} # sub MailValid
# sub: Check if names, addresses, or message
contain possibly offensive terms
sub CheckForOffensiveTerms
{
my (@ta) = @_;
foreach $t (@ta)
{
if ($t =~
/\bpussy|\bcunt|\bbitch|fuck|asshole/i)
{ return 1; }
if ($t =~
/pussie|\bbible\b|blowjob|\bbutt\b|butthead/i
) { return 1; }
if ($t =~ /ass
hole|bastard|christ\b|\bcock|\bbathroom\b/i){
return 1; }
if ($t =~
/clitor|cornhol|crap|\bcum\b|cunnili/i)
{ return 1; }
if ($t =~
/defecat|honkey|horny|nigger|ofay/i)
{ return 1; }
if ($t =~
/dickhead|douche|\bfag\b|faggot/i)
{ return 1; }
if ($t =~ /fellatio|genital|goddam|god
dam|\bhomo\b/i) { return 1; }
if ($t =~
/\bjesus\b|\bjew\b|\bkike\b|masturbat|niger\b
/i) { return 1; }
if ($t =~
/peckerwood|penis|\bpiss\b|whore|rape/i)
{ return 1; }
if ($t =~
/satan|masoc|semen|shit|\bslut|\bdago\b/i)
{ return 1; }
if ($t =~
/\btit\b|twat|urinat|vagina|suck/i)
{ return 1; }
if ($t =~ /blowjob|rim job|rimjob|blow
job/i) { return 1; }
if ($t =~ /fart|felch|potty|\bjiz|\bkill
you\b/i) { return 1; }
}
return 0;
} # sub CheckForOffensiveTerms
# sub: Link text for bottom of default pages
sub PageAddendum
{
return '';
} # sub PageAddendum
# Assign subject and body of e-mails to
appropriate global variables
sub GetEMailText
{
# if there is a template file, read it
if(defined($InboundData{'template'}) &&
$InboundData{'template'})
{
&ExtractEMailData($InboundData{'template'});
if($VisitorMailSubject) {
$VisitorMailSubject =~ s/^[ \t]*//; }
if($FriendMailSubject) {
$FriendMailSubject =~ s/^[ \t]*//; }
if($MaintainerMailSubject) {
$MaintainerMailSubject =~ s/^[ \t]*//; }
}
# Assign defaults where variables are empty.
# If no template file exists, all
variables will be empty.
if (! $FriendMailSubject)
{ $FriendMailSubject = '[visitorname]
recommends [sitename]!'; }
if (! $FriendMailText)
{
$FriendMailText = ' <html>
<head>
<title>r</title>
</head><b>Dear [friendname],</b>
[visitorname] of [visitormail] liked
"[sitename]" well enough to recommend it to
you. It is located at <[siteurl]>.
If you do not know [visitorname] you may
ignore this message.
We trust your experience will be positive
like [visitorname]\'s was. Just point your
browser at <[siteurl]>.
[ifmessage]In addition to recommending
"[sitename]", [visitorname] sends this
message for you:
"[message]"[/ifmessage]
Thank you for your time.
';
} # if (! $FriendMailText)
if (! $VisitorMailSubject)
{ $VisitorMailSubject = 'Thank you for your
recommendation'; }
if (! $VisitorMailText)
{
$VisitorMailText = 'Dear [visitorname],
Thank you for recommending "[sitename]" to
[friendname] of [friendmail] on [date].
Your generosity is much appreciated. We hope
[friendname] will enjoy "[sitename]" as much
as you did.
If you wish to visit us again, the URL is
<[siteurl]>.
';
} # if (! $VisitorMailText)
if (! $MaintainerMailSubject)
{ $MaintainerMailSubject =
'RECOMMENDATION'; }
if (! $MaintainerMailText)
{
$MaintainerMailText = ' Date:
[date]
Time: [time]
Visitor\'s name: [visitorname]
Visitor\'s address: [visitormail]
Friend\'s name: [friendname]
Friend\'s address: [friendmail]
Friend\'s address: [friendmail2]
Friend\'s address: [friendmail3]
Friend\'s address: [friendmail4]
[ifmessage][visitorname]\'s message to
[friendname]:
-----------------------
[message]
-----------------------[/ifmessage]
Yeah!
';
} # if (! $MaintainerMailText)
# Parse the e-mail texts for token
replacements
$VisitorMailSubject =
&ParseEMailBodyText($VisitorMailSubject);
$VisitorMailText =
&ParseEMailBodyText($VisitorMailText);
$FriendMailSubject =
&ParseEMailBodyText($FriendMailSubject);
$FriendMailText =
&ParseEMailBodyText($FriendMailText);
$MaintainerMailSubject =
&ParseEMailBodyText($MaintainerMailSubject);
$MaintainerMailText =
&ParseEMailBodyText($MaintainerMailText);
} # sub GetEMailText
# sub: Extract data from file containing
template e-mails
sub ExtractEMailData
{
my ($fn) = @_;
my $line;
my ($b,$v,$f,$m) = (0,0,0,0);
if(! open(THISFILE,"$fn"))
{ ErrorHTML("Can't open $fn\n<br>We're in
the middle of debugging a new version. Sorry
for the inconvienence."); }
$line = <THISFILE>;
while($line ne "")
{
if($line =~ /^\[VISITORMAIL\]/i) { $v
= 1; $line = <THISFILE>; $b = 1; }
if($line =~ /^\[FRIENDMAIL\]/i) { $f
= 1; $line = <THISFILE>; $b = 1; }
if($line =~
/^\[FRIENDMAIL2\]/i) { $f = 1; $line =
<THISFILE>; $b = 1; }
if($line =~
/^\[FRIENDMAIL3\]/i) { $f = 1; $line =
<THISFILE>; $b = 1; }
if($line =~
/^\[FRIENDMAIL4\]/i) { $f = 1; $line =
<THISFILE>; $b = 1; }
if($line =~ /^\[MAINTAINERMAIL\]/i) { $m
= 1; $line = <THISFILE>; $b = 1; }
if($line =~ /^\[\/VISITORMAIL\]/i) { $v
= 0; $line = <THISFILE>; }
if($line =~ /^\[\/FRIENDMAIL\]/i) { $f
= 0; $line = <THISFILE>; }
if($line =~ /^\[\/MAINTAINERMAIL\]/i) { $m
= 0; $line = <THISFILE>; }
if($line =~ /^\[SUBJECT\]/i)
{
$line =~ s/\[SUBJECT\]//i;
chop $line;
if($v) { $VisitorMailSubject = $line; }
if($f) { $FriendMailSubject = $line; }
if($m) { $MaintainerMailSubject = $line; }
}
else
{
if($v) { $VisitorMailText .= $line; }
if($f) { $FriendMailText .= $line; }
if($m) { $MaintainerMailText .= $line; }
}
$line = <THISFILE>;
} # while($line ne "")
close(THISFILE);
return $b;
} # sub ExtractEMailData
# sub: Parse the e-mail text to replace
tokens with values.
sub ParseEMailBodyText
{
my ($ts) = @_;
if( (defined($InboundData{message})) &&
($InboundData{message} =~ /[a-zA-Z]/) )
{
$ts =~ s/\[ifmessage\]//gi;
$ts =~ s/\[\/ifmessage\]//gi;
$ts =~
s/\[message\]/$InboundData{message}/gi;
}
else
{
if($ts =~ /[\r\t\n\f]\[ifmessage\]/si)
{ $ts =~
s/[\r\t\n\f]\[ifmessage\]/\[ifmessage\]/sgi;
}
else
{ $ts =~
s/\[\/ifmessage\][\r\t\n\f]/\[\/ifmessage\]/s
gi; }
$ts =~
s/\[ifmessage\].*\[\/ifmessage\]//sgi;
$ts =~ s/\[ifmessage\]\[\/ifmessage\]//sgi;
}
$ts =~ s/^[\r\n\f]//s;
$ts =~
s/\[visitorname\]/$InboundData{visitorname}/g
i;
$ts =~
s/\[visitormail\]/$InboundData{visitormail}/g
i;
$ts =~
s/\[friendname\]/$InboundData{friendname}/gi;
$ts =~
s/\[friendmail\]/$InboundData{friendmail}/gi;
$ts =~
s/\[friendmail2\]/$InboundData{friendmail}/gi
;
$ts =~
s/\[sitename\]/$InboundData{sitename}/gi;
$ts =~
s/\[siteurl\]/$InboundData{siteurl}/gi;
$ts =~ s/\[date\]/$Date/gi;
$ts =~ s/\[time\]/$Time/gi;
return $ts;
} # sub ParseEMailBodyText
# sub: Send e-mail to the person the
website/page was recommended to
sub SendFriendMail
{
my $toaddress = $InboundData{friendmail};
my $from = $InboundData{maintainermail};
my $subject = $FriendMailSubject;
open(MAIL,">$TempMailFile1");
print MAIL "$FriendMailText\n";
close (MAIL);
system("$MailProgram $TempMailFile1
-t $toaddress -s \"$subject\" -i \"$from\" -f
\"$from\" -html");
} # sub SendFriendMail
# sub: Send e-mail to the person 2 the
website/page was recommended to
sub SendFriendMail2
{
my $toaddress = $InboundData{friendmail2};
my $from = $InboundData{maintainermail};
my $subject = $FriendMailSubject;
open(MAIL,">$TempMailFile1");
print MAIL "$FriendMailText\n";
close (MAIL);
system("$MailProgram $TempMailFile1 -
-t $toaddress -s \"$subject\" -i \"$from\" -f
\"$from\" -html");
} # sub SendFriendMail2
# sub: Send e-mail to the person 3 the
website/page was recommended to
sub SendFriendMail3
{
my $toaddress = $InboundData{friendmail3};
my $from = $InboundData{maintainermail};
my $subject = $FriendMailSubject;
open(MAIL,">$TempMailFile1");
print MAIL "$FriendMailText\n";
close (MAIL);
system("$MailProgram $TempMailFile1 -
-t $toaddress -s \"$subject\" -i \"$from\" -f
\"$from\" -html");
} # sub SendFriendMail3
# sub: Send e-mail to the person 4 the
website/page was recommended to
sub SendFriendMail4
{
my $toaddress = $InboundData{friendmail4};
my $from = $InboundData{maintainermail};
my $subject = $FriendMailSubject;
open(MAIL,">$TempMailFile1");
print MAIL "$FriendMailText\n";
close (MAIL);
system("$MailProgram $TempMailFile1 -
-t $toaddress -s \"$subject\" -i \"$from\" -f
\"$from\" -html");
} # sub SendFriendMail4
# sub: If appropriate, send e-mail to the
visitor
sub SendVisitorMail
{
my $toaddress = $InboundData{visitormail};
my $from = $InboundData{maintainermail};
my $subject = $VisitorMailSubject;
open(MAIL,">$TempMailFile2");
if( (defined($InboundData{visitorgetsmail}))
&& ($InboundData{visitorgetsmail} =~
/^[yY1l]|^ *[yY1l]/) )
{ print MAIL "$VisitorMailText\n"; }
if(defined($InboundData{sendcopy}) &&
($InboundData{sendcopy} =~ /^[yY1l]|^
*[yY1l]/) )
{
print MAIL "-" x 33 . "\n";
print MAIL "-" x 33 . "\n";
print MAIL "<br>\n";
print MAIL "As you requested, here is a
copy of your recommendation:\n\n";
print MAIL "$FriendMailText\n";
print MAIL "-" x 33 . "\n";
}
close (MAIL);
sleep 3;
system("$MailProgram $TempMailFile2 -t
$toaddress -s
\"$subject\" -i \"$from\" -f
\"$from\" -html");
} # sub SendVisitorMail
# sub: Send e-mail to the maintainer
sub SendMaintainerMail
{
my $toaddress =
$InboundData{maintainermail};
my $from = $InboundData{maintainermail};
my $subject = $MaintainerMailSubject;
open(MAIL,">$TempMailFile3");
if($Offensive)
{
print MAIL "-" x 33 . "\n";
print MAIL "This may contain offensive
words or phrases and NO MAIL WAS SENT!\n";
print MAIL "-" x 33 . "\n\n";
}
print MAIL "$MaintainerMailText\n";
print MAIL "-" x 33 . "\n";
print MAIL "-" x 33 . "\n";
close (MAIL);
system("$MailProgram $TempMailFile3 t $toaddress
-s
\"$subject\" -i \"$from\" -f \"$from\"");
} # sub SendMaintainerMail
# sub: Give visitor an acknowledgment via
her/his browser
sub ThankYouHTML
{
print "Content-type: text/html\n\n";
print '<html><head><title>thank you for
sending the email to your
colleague</title></head><body
bgcolor="#ffffff" text="#000080"
link="#ff8000" vlink="#8000ff"
alink="#ff8000">';
print '<center><h1>thank you for sending the
email to your colleague</h1></center>';
print '<center><h3></center>
</h3>';
print '<h3><br><br>';
print '</h3>';
my $t = &PageAddendum;
print "<hr width=33\%>$t</body></html>\n";
} # sub ThankYouHTML
#
# ------- End: MasterRecommend
program -------
#
#===============================
__END__
------------------------------
Date: Thu, 19 Jul 2001 22:13:33 -0000
From: cberry@cinenet.net (Craig Berry)
Subject: Re: Academic exercise - string/variable interpolation for arrays
Message-Id: <tlemsd5b9lhrd1@corp.supernews.com>
Mr. Sunray (djberge@uswest.com) wrote:
: All I'm trying to do is push a name onto separate arrays based on the
: the first letter of that name. See the code below - it's pretty short.
:
: my(@a,@b,@c);
: my @lastnames = qw(Alberts Brown Cringle);
:
: foreach my $name(@lastnames){
: no strict 'refs';
: my $char = lc((split('',$name))[0]); # Get first letter of last name and lowercase it
Easier to do:
my $char = lc substr $name, 0, 1;
: push(@$char, $name); # Doesn't fail, but where did it go?
Lexical ('my') variables aren't accessible via symrefs. See perldoc -q
'variable name'. Your code is pushing onto the global array named by
$char, not the lexical.
--
| Craig Berry - http://www.cinenet.net/~cberry/
--*-- "Brute force done fast enough looks slick."
| - William Purves
------------------------------
Date: Thu, 19 Jul 2001 22:17:46 GMT
From: tiltonj@erols.com (Jay Tilton)
Subject: Re: Academic exercise - string/variable interpolation for arrays
Message-Id: <3b575b75.85183236@news.erols.com>
On Thu, 19 Jul 2001 16:14:59 -0500, "Mr. Sunray" <djberge@uswest.com> wrote:
>All I'm trying to do is push a name onto separate arrays based on the
>the first letter of that name. See the code below - it's pretty short.
>
>#!/usr/local/bin/perl -w
>use strict;
>
>my(@a,@b,@c);
[snip]
Symbolic references do not work on variables declared as my().
Change that to our() for the program to work as expected.
Even better, find an approach that does not use symrefs.
------------------------------
Date: Thu, 19 Jul 2001 22:30:18 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: Academic exercise - string/variable interpolation for arrays
Message-Id: <3B575FCB.9134C8F4@acm.org>
"Mr. Sunray" wrote:
>
> Ok, so I finished a project here so now I'm futzing around for a few
> minutes trying to expand my Perl knowledge.
>
> Before I continue (and before you start screaming) - yes, I know all
> about hashes, data structures, etc. I've read the docs and done a
> "perldoc -q variables". This is primarily academic exercise.
>
> I've seen how to interpolate strings into scalars, but haven't had any
> luck with arrays.
>
> All I'm trying to do is push a name onto separate arrays based on the
> the first letter of that name. See the code below - it's pretty short.
>
> #!/usr/local/bin/perl -w
> use strict;
> my(@a,@b,@c);
> my @lastnames = qw(Alberts Brown Cringle);
>
> foreach my $name(@lastnames){
> no strict 'refs';
> my $char = lc((split('',$name))[0]); # Get first letter of last name
> # and lowercase it
> push(@$char, $name); # Doesn't fail, but where
> # did it go?
> }
>
> print join(',',@a),"\n"; # Nothing here
Lexical variables (my(@a,@b,@c);) can not be used as symbolic references
(@$char).
John
--
use Perl;
program
fulfillment
------------------------------
Date: 20 Jul 2001 02:24:04 +0200
From: Slaven Rezic <slaven.rezic@berlin.de>
Subject: Re: Any perl module for XML Explorer tree display/edit?
Message-Id: <874rs84fdn.fsf@vran.herceg.de>
"M.L." <mel2000@hotmaildot.com> writes:
> I'm a newbie to XML currently reading up on various Perl modules to
> manipulate XML. My first goal is to find a module that can easily slurp an
> XML tree into a hash, and then back to an XML tree. With all the
> possibilities, I'm having trouble making up my mind.
>
> After that task my greatest concern will be displaying and modifying the
> tree. Ideally, I would like to:
>
> 1. Convert my spreadsheet-like database to an expanding/collapsing XML
> folder tree resembling that of Windows Explorer
Look at Tk::XMLViewer for a Perl/Tk solution.
Regards,
Slaven
--
Slaven Rezic - slaven.rezic@berlin.de
tknotes - A knotes clone, written in Perl/Tk.
http://ptktools.sourceforge.net/#tknotes
------------------------------
Date: Fri, 20 Jul 2001 00:43:51 +0200
From: "carlos" <carlos@plant.student.utwente.nl>
Subject: Re: don't laugh
Message-Id: <9j7nr8$pfa$1@dinkel.civ.utwente.nl>
what everyone else said, plus:
@ARGV[$NUM] should be $ARGV[$NUM] , as perl would have told you of you'd
used the -w switch.
--
carl0s
"James Warpup" <jwarpup1@home.com> wrote in message
news:UeE57.31194$PF1.1521178@e420r-atl2.usenetserver.com...
> i can't figure out how to get perl to output to a file,
>
> this is just a little script that will become part of the larger project
i'm
> working on.
>
> $OUT = 'c:\out.txt';
> open (FILEOUT, $OUT);
> $NUM = 0;
> $NUM2 = 1;
> while ( $NUM <= 10 ) {
> print FILEOUT "$NUM2 @ARGV[$NUM] \n\n";
> $NUM += 1;
> $NUM2 +=1;
> }
>
> but it doesn't write to $OUT
>
> any guesses as to why?
>
>
>
>
------------------------------
Date: Fri, 20 Jul 2001 00:17:27 GMT
From: PerlFAQ Server <faq@denver.pm.org>
Subject: FAQ: How can I compile Perl into Java?
Message-Id: <rMK57.4$zH9.222445056@news.frii.net>
This message is one of several periodic postings to comp.lang.perl.misc
intended to make it easier for perl programmers to find answers to
common questions. The core of this message represents an excerpt
from the documentation provided with every Standard Distribution of
Perl.
+
How can I compile Perl into Java?
You can also integrate Java and Perl with the Perl Resource Kit from
O'Reilly and Associates. See http://www.oreilly.com/catalog/prkunix/ .
Perl 5.6 comes with Java Perl Lingo, or JPL. JPL, still in development,
allows Perl code to be called from Java. See jpl/README in the Perl
source tree.
-
Documents such as this have been called "Answers to Frequently
Asked Questions" or FAQ for short. They represent an important
part of the Usenet tradition. They serve to reduce the volume of
redundant traffic on a news group by providing quality answers to
questions that keep coming up.
If you are some how irritated by seeing these postings you are free
to ignore them or add the sender to your killfile. If you find
errors or other problems with these postings please send corrections
or comments to the posting email address or to the maintainers as
directed in the perlfaq manual page.
Answers to questions about LOTS of stuff, mostly not related to
Perl, can be found by pointing your news client to
news:news.answers
or to the many thousands of other useful Usenet news groups.
Note that the FAQ text posted by this server may have been modified
from that distributed in the stable Perl release. It may have been
edited to reflect the additions, changes and corrections provided
by respondents, reviewers, and critics to previous postings of
these FAQ. Complete text of these FAQ are available on request.
The perlfaq manual page contains the following copyright notice.
AUTHOR AND COPYRIGHT
Copyright (c) 1997-1999 Tom Christiansen and Nathan
Torkington. All rights reserved.
This posting is provided in the hope that it will be useful but
does not represent a commitment or contract of any kind on the part
of the contributers, authors or their agents.
03.23
--
This space intentionally left blank
------------------------------
Date: 19 Jul 2001 22:16:43 GMT
From: Ilmari Karonen <iltzu@sci.invalid>
Subject: Re: FAQ: Is it unsafe to return a pointer to local data?
Message-Id: <995580905.20699@itz.pp.sci.fi>
In article <slrn9lcjbh.1rf.mgjv@verbruggen.comdyn.com.au>, Martien Verbruggen wrote:
>On Wed, 18 Jul 2001 18:17:01 GMT,
> PerlFAQ Server <faq@denver.pm.org> wrote:
>> +
>> Is it unsafe to return a pointer to local data?
> ^^^^^^^
>
>Shouldn't that be "reference"?
Naw. The people who'd ask that would usually say "pointer".
The _answer_, on the other hand, should explicitly state that "This is
one of the ways in which Perl references are unlike C pointers."
--
Ilmari Karonen -- http://www.sci.fi/~iltzu/
"Get real! This is a discussion group, not a helpdesk. You post something,
we discuss its implications. If the discussion happens to answer a question
you've asked, that's incidental." -- nobull in comp.lang.perl.misc
------------------------------
Date: Thu, 19 Jul 2001 22:11:38 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: Generic Language interpreter in Perl?
Message-Id: <vqmelt8co4ue5berc8lvgqf3r560ka8um5@4ax.com>
Tony Curtis wrote:
>With a slight syntax change, you could probably use
>something like Config::IniFiles for this.
>
> [compressor]
> pattern = interface.*.dat
> time = 15d
> notify = ...@...
>
> [remove]
> pattern = ...
> time = 30d
> ...
XML is another candidate for file syntax.
--
Bart.
------------------------------
Date: 19 Jul 2001 15:11:46 GMT
From: Juha Laiho <Juha.Laiho@iki.fi>
Subject: Re: GnuPG encrypting from STDIN in CGI
Message-Id: <9j6tbi$s5b$1@ichaos.ichaos-int>
"Carsten Menke" <bootsy52@gmx.net> said:
>And this is what I could not use, because the provider doesn't allow to
>install any modules nor does he have the gnupg.pm .
I somehow wonder how they make the division between a script and a module;
and what they see as the significant distinction between the two (this esp.
for modules that are pure perl code) - what is the reasoning to allow
code written as a script and disallow breaking the same code into modules.
But enough with rhetorics; I actually don't want to hear the answer for
the above..
>I found out more meanwhile the actual problem I got here is, how to open
>a process (piping) for reading and writing? Because in the first instance
>I need to write to the process in the way of open(PIPE, "| $command $options -")
>and then write to this PIPE
>print PIPE $input;
>
>No I have to get the input using a PIPE opened to read.
Hmm.. "perldoc -q pipe" gives me the following question
How can I open a pipe both to and from a command?
... and also the answer for it. So, please check the FAQ.
--
Wolf a.k.a. Juha Laiho Espoo, Finland
(GC 3.0) GIT d- s+: a C++ UH++++ UL++++$ P++@ L+++ E(-) W+$@ N++ !K w !O
!M V PS(+) PE Y+ PGP(+) t- 5 !X R !tv b+ !DI D G e+ h--- r+++ y+++
"...cancel my subscription to the resurrection!" (Jim Morrison)
------------------------------
Date: Thu, 19 Jul 2001 23:51:04 GMT
From: tim@vegeta.ath.cx (Tim Hammerquist)
Subject: Re: How to run Perl on MS-DOS
Message-Id: <slrn9let8r.o58.tim@vegeta.ath.cx>
Me parece que Ilmari Karonen <iltzu@sci.invalid> dijo:
> In article <slrn9l9imp.va1.tim@vegeta.ath.cx>, Tim Hammerquist wrote:
> >
> >I have to buy a US$100 bash environment to be able to consistently use
> >*nix commands in DOS/Win32.
>
> $100?
>
> ???
>
> Who the heck's pulling that one off? I definitely didn't have to pay
> anything to get bash and the rest of the toolbox for the Win32 box --
> I got it as a bonus when I downloaded the free Cygwin compiler suite.
Ah! I was speaking from when Cygnus was pulling its Cygwin 1.0 scam
($100). (I've used Cygwin b20 since.) I checked back on the cygwin
site after your post and was (fortunately) proven wrong.
Thanks!
--
guru, n:
A computer owner who can read the manual.
------------------------------
Date: Thu, 19 Jul 2001 18:30:56 +0500
From: Robert Sherman <rsherman@ce.gatech.edu>
Subject: Re: ide for perl?
Message-Id: <3B56E110.7080206@ce.gatech.edu>
Jeff D. Hamann wrote:
> Okay, I know this is going to sound soooo non-unix, but is there an ide that
> supports perl out there. VB is killing me but I need to be able to debug
> script code before running huge databas processing tasks that call shared
> libs... i guess the ultimate would be an ide that supports c,php, and perl,
> but that's the breaks i guess....
>
> Thanks,
> Jeff.
>
> --
> Jeff D. Hamann
> Hamann, Donald and Associates
> PO Box 1421
> Corvallis, Oregon USA 97339-1421
> 541-740-5988
> jeff_hamann@hamanndonald.com
> www.hamanndonald.com
>
>
>
>
komodo from www.activestate.com is a possibility...haven't tried it
though...
------------------------------
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.
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 1338
***************************************
