[28466] in Perl-Users-Digest
Perl-Users Digest, Issue: 9830 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Oct 10 21:06:03 2006
Date: Tue, 10 Oct 2006 18:05:09 -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 Tue, 10 Oct 2006 Volume: 10 Number: 9830
Today's topics:
binary searching in perl <jack_posemsky@yahoo.com>
Re: binary searching in perl xhoster@gmail.com
Eliminating required fields in perl script for iis 6.0 birdfludeathclock@yahoo.com
Re: Eliminating required fields in perl script for iis <jgibson@mail.arc.nasa.gov>
Re: FAQ 4.22 How do I expand function calls in a string <brian.d.foy@gmail.com>
Re: Help with test program <ced@blv-sam-01.ca.boeing.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 10 Oct 2006 11:16:28 -0700
From: "Jack" <jack_posemsky@yahoo.com>
Subject: binary searching in perl
Message-Id: <1160504188.581251.125660@h48g2000cwc.googlegroups.com>
Hi I need to use a fast search mechanism that does pattern matching -
array iteration and hash lookups both have issues in some way.. does
anyone have another suggestion, like binary searches ( not necessarily
"binary tree") that will allow for a fast pattern match - this article
indicates using Search::Dict, does anyone have thoughts or suggestions
here based on perhaps other modules that could be used ?
http://www.icdevgroup.org/interchange/doc-5.0/frames/icdatabase_30.html
------------------------------
Date: 10 Oct 2006 19:07:17 GMT
From: xhoster@gmail.com
Subject: Re: binary searching in perl
Message-Id: <20061010151010.446$eF@newsreader.com>
"Jack" <jack_posemsky@yahoo.com> wrote:
> Hi I need to use a fast search mechanism that does pattern matching -
"pattern matching" is exceptionally vague. Any searching method that
allows completely general pattern matching is going to be fairly slow.
There may be methods that work with special kinds of pattern matching, but
we certainly can't recommend what they would be if you don't tell us what
specific type of pattern matching you are interested in.
> array iteration and hash lookups both have issues in some way..
Which ways?
> does
> anyone have another suggestion, like binary searches
You can't do a binary searching on unorderable data. You can't
order data without knowing the precise nature of the pattern to be matched.
So you can't effectively use binary search for a completely general
"pattern matching".
> ( not necessarily
> "binary tree") that will allow for a fast pattern match - this article
> indicates using Search::Dict, does anyone have thoughts or suggestions
> here based on perhaps other modules that could be used ?
Without having more refined requirements, no.
Xho
--
-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service $9.95/Month 30GB
------------------------------
Date: 10 Oct 2006 15:10:40 -0700
From: birdfludeathclock@yahoo.com
Subject: Eliminating required fields in perl script for iis 6.0 server
Message-Id: <1160518240.305182.27690@b28g2000cwb.googlegroups.com>
Hello Group,
I am trying to figure out how I can eliminate the required fields
section in a perl script that is posted from a form. We do not want
the user that fills in the web form to have any mandatory fields that
he/she must fill out. All fields should be optional. I've tried to
tackle this problem myself but can not seem to get it to work. It
doesn't help to not be much of a programmer. I have included the .pl
script below
Thanks,
#sendmail subroutine needs Socket
use Socket;
#FormDB needs to copy files
use File::Copy;
#Error reporting needs NT Event Log support
use Win32::EventLog;
#Error reporting needs NT Event Log Source Register
use Win32::EventLog::Message;
#Reserved for future use of Net Messages
use Win32::Message;
#Give access to the NT Registry Database
use Win32::TieRegistry;
#check to see if someone is trying to run my script through a GET URL
or something.. if so error out, because I don't want
people doing this..
if ($ENV{'REQUEST_METHOD'} eq "GET") {
death("GET method not allowed, possibly someone probing my script for
security holes?",1,10);
}
#read standard input (HTTP server CGI)
read (STDIN, $input, $ENV{'CONTENT_LENGTH'}) or death("Can't read STDIN
from WWW server!",3,20);
@parse = split(/&/,$input);
#Find FormDb Number to use
foreach $item (@parse)
{
#Split pairs, remove URL formatting
($name, $data) = split(/=/,$item,2);
$data =~ tr/+/ /;
$data =~ s/%(..)/pack("c",hex($1))/ge;
$name =~ tr/+/ /;
$name =~ s/%(..)/pack("c",hex($1))/ge;
if(lc($name) eq "formdb")
{
$formdb = int($data);
if($formdb < 1) { death("FormDb Number Not Valid!!",3,30); }
}
}
if($formdb eq undef) { death("Couldn't get FormDb Number!!",3,40); }
#Load Vaules From Registry
$dbname =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\dbname$formdb"}
or death("Can't open
!!",3,90);
#Increament run counter
$runcount =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\runcount$formdb"}
or death("Can't
open registry for runcount!!",3,100);
$runcount++;
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\runcount$formdb"}
= $runcount or death("Can't
write to registry for runcount!!",3,110);
#Get Referbce DBF location from registry
$refdb =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\refdb$formdb"}
or death("Can't open
registry for refdb!!",3,120);
#Get Dump Dir from Registry
$regdd =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\dumpdir$formdb"}
or death("Can't open
registry for dumpdir!!",3,130);
#Get referrence ADX file location from registry
$refadx =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\refadx$formdb"}
or death("Can't open
registry for refadx!!",3,140);
#Get host name to send net messages to
$msghost =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\msghost$formdb"}
or death("Can't open
registry for msghost!!",3,150);
#DEBUG LINE - Test NT Registry access - for storing run time stats
$good =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\good$formdb"}
or death("Can't open
registry for good stat!!",3,160);
$wrn =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\warning$formdb"}
or death("Can't open
registry for warning stat!!",3,170);
$ers =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\error$formdb"}
or death("Can't open registry
for error stat!!",3,180);
$conflicts =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\conflicts$formdb"}
or death("Can't open
registry for conflict stats!!",3,190);
#Get e-mail info from registry
$smtpserv =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\smtpserv$formdb"}
or death("Can't
open registry for smtpserv!!",3,200);
$email_to =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\emailto$formdb"}
or death("Can't open
registry for emailto!!",3,210);
$emfd =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\emailfield$formdb"}
or death("Can't open
registry for emailfield!!",3,220);
#Get URL link for display on error pages
$errlink =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\errlink$formdb"}
or death("Can't open
registry for errlink!!",3,230);
#Clean up memory used to read from STDIN
undef $input;
#Parse Loop - Format data, find setup info, find required fields, find
lumps, find email comments
foreach $item (@parse)
{
#Split pairs, remove URL formatting
($name, $data) = split(/=/,$item,2);
$data =~ tr/+/ /;
$data =~ s/%(..)/pack("c",hex($1))/ge;
$name =~ tr/+/ /;
$name =~ s/%(..)/pack("c",hex($1))/ge;
#Start of parse code block
SWITCH:
{
#Is it setup data?
if(lc($name) eq "returnpage_name") { $returnpage_name = $data; last
SWITCH; }
if(lc($name) eq "returnpage_url") { $returnpage_url = $data; last
SWITCH; }
if(lc($name) eq "email_subject") { $email_subject = $data; last
SWITCH; }
#Is it a required field? (marked !...)
if(index($name,"!") eq 0)
{
if(length($data) eq 0) { $required_miss = 1; last SWITCH; }
$name = substr($name,1,(length($name) - 1));
}
#Is $data empty?
if($data eq undef) { last SWITCH; }
#Remove CR and LF from $data
$data =~ tr/\x0A/ /;
$data =~ tr/\x0D/ /;
#Is it a lumped field? (marked @...@...)
if(index($name,"@") eq 0)
{
$name = substr($name,1,(length($name) - 1));
if(index($name,"@") eq -1) { $lump_noinfo = 1; last SWITCH; }
($lump_field, $lump_info) = split(/@/,$name,2);
#Does it have a # description/data flipper? (marked @...@#...)
if(index($lump_info,"#") eq 0)
{
$lump_info = substr($lump_info,1,(length($lump_info) - 1));
$DBFIELD{$lump_field} = join("",$DBFIELD{$lump_field},$data,"
",$lump_info,", ");
last SWITCH;
}
else
{
#This is what a check box returns when checked
if(lc($data) eq "on")
{
$DBFIELD{$lump_field} =
join("",$DBFIELD{$lump_field},$lump_info,", ");
last SWITCH;
}
else
{
$DBFIELD{$lump_field} =
join("",$DBFIELD{$lump_field},$lump_info,":
",$data,", ");
last SWITCH;
}
}
}
#Is it a email comment? (marked *xx)
if(index($name,"*") eq 0)
{
$name = substr($name,1,(length($name) - 1));
$COMMENT{$name} = $data;
last SWITCH;
}
#Must be a DB Field!
$DBFIELD{$name} = $data;
}
#End of parse code block
#Check error traps
if($required_miss eq 1) { death("Required field $name empty!",1,1020);
}
if($lump_noinfo eq 1) { death("Form design flaw - Lump $name with no
info!",3,1030); }
}
#Clean up memory used by parse loop
undef @parse;
undef $item;
undef $name;
undef $data;
undef $lump_field;
undef $lump_info;
#Check for missing data
if(%DBFIELD eq undef) { death("No DB Field Data!!! How did that
happen??",3,1040); }
if($returnpage_name eq undef) { death("Form design flaw - Missing
Return Page Name!!",3,1050); }
if($returnpage_url eq undef) { death("Form design flaw - Missing Return
Page URL!!",3,1060); }
if($smtpserv eq undef) { death("Missing SMTPSERV!!",3,1070); }
if($email_to eq undef) { death("Missing Email To!!",3,1080); }
if($email_subject eq undef) { death("Form design flaw - Missing Email
Subject",3,1090); }
if($DBFIELD{$emfd} eq undef) { death("Missing Email From
Address",1,1100); }
if(index($DBFIELD{$emfd},"\x40") eq -1) { death("Bad E-mail From
Address",1,1110); }
if(index($DBFIELD{$emfd},"\x2E") eq -1) { death("Bad E-mail From
Address",1,1120); }
#Prepare to make the DBF and DBT files, put in dump dir (this is the
tricky part!)
#Open Refernce DBF
open(DBREF, $refdb) or death("Could not open REF DBF during DB
create!",2,1130);
binmode(DBREF) or death("Could not set BIN mode on REF DBF during DB
create!",2,1140);
#Check for 0x8B as start of ref dbf header, other wise a bad ref dbf!!
sysread(DBREF,$heap,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1150);
if($heap eq "\x8B") { $dbrcount++; } else { death("Invalid header start
(not 0x8B) in REF DBF during DB create!",3,1160); }
#Get REF DBF created year
sysread(DBREF,$heap,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1170);
$dbrcount++;
$dbryear = ord($heap) + 1900;
#Get REF DBF created month
sysread(DBREF,$heap,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1180);
$dbrcount++;
$dbrmonth = ord($heap);
#Get REF DBF created day
sysread(DBREF,$heap,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1190);
$dbrcount++;
$dbrday = ord($heap);
#Skip next 4 bytes (num records in ref dbf should be 0 any way!)
sysread(DBREF,$heap,4) or death("Unexpected EOF on REF DBF during DB
create!",3,1200);
$dbrcount++;
$dbrcount++;
$dbrcount++;
$dbrcount++;
#Read 2 byte word, total lenght of header in bytes
sysread(DBREF,$heap1,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1210);
$dbrcount++;
sysread(DBREF,$heap2,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1220);
$dbrcount++;
$dbrbytes = (ord($heap1) + ( ord($heap2) * 256));
#Skip next 20 bytes, run out rest of header
do
{
sysread(DBREF,$heap,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1230);
$dbrcount++;
} until $dbrcount eq 32;
#Create $rdinfo, contains info about Ref DB
$rdinfo = join("","Reference DBF file created:
",$dbryear,"-",$dbrmonth,"-",$dbrday," - Bytes: ",$dbrbytes);
#Read fields from REF, find fields in input, write to dump DBF string
do
{
#Read next field
$doit = 1;
$fname = "";
$fcount = 0;
do
{
sysread(DBREF,$heap,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1240);
$dbrcount++;
$fcount++;
if($heap ne "\x00")
{
$fname = join("",$fname,$heap);
}
else { $doit = 0; }
} until $doit eq 0;
#Check for valid lenght
if(length($fname) eq 0) { death("Invalid field in REF DBF during DB
create1!",3,1250); }
if(length($fname) > 11) { death("Invalid field in REF DBF during DB
create2!",3,1260); }
#Run out padding to field type byte
if($fcount < 11)
{
do
{
sysread(DBREF,$heap,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1270);
$dbrcount++;
$fcount++;
} until $fcount eq 11;
}
#Get field type byte
sysread(DBREF,$heap,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1280);
$dbrcount++;
$ftype = $heap;
#Skip 4 bytes of padding
sysread(DBREF,$heap,4) or death("Unexpected EOF on REF DBF during DB
create!",3,1290);
$dbrcount++;
$dbrcount++;
$dbrcount++;
$dbrcount++;
#Get field lenght byte
sysread(DBREF,$heap,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1300);
$dbrcount++;
$flength = $heap;
#Get Field Decimal length byte
sysread(DBREF,$heap,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1310);
$dbrcount++;
$fdecimal = $heap;
#Skip 14 bytes of remaining padding in field
$fcount = 0;
do
{
sysread(DBREF,$heap,1) or death("Unexpected EOF on REF DBF during DB
create!",3,1320);
$dbrcount++;
$fcount++;
} until $fcount eq 14;
#Add current field to DBF field stack and data stack if found in input
if($DBFIELD{$fname} ne undef)
{
#Field stack
$fheap = $fname;
if(length($fname) < 11)
{
$fcount = length($fname);
do
{
$fheap = join("",$fheap,"\x00");
$fcount++;
} until $fcount eq 11;
}
$heap =
join("",$fheap,$ftype,"\x00\x00\x00\x00",$flength,$fdecimal,"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00");
if(length($heap) eq 32)
{
$fstack = join("",$fstack,$heap);
}
else { death("Error formatting DBF field stack!",2,1330); }
#Data stack
#Numeric data
if($ftype eq "N")
{
#Strip out any none numeric values, replace with "0", leave dashs
"-" and decimals "."
$DBFIELD{$fname} =~ tr/\x00-\x2C/\x30/;
$DBFIELD{$fname} =~ tr/\x2F/\x30/;
$DBFIELD{$fname} =~ tr/\x3A-\xFF/\x30/;
#Find the dash used for 9 digit zips, remove it but preserve rest of
string
if(index($DBFIELD{$fname},"\x2D") ne -1)
{
$dindx = index($DBFIELD{$fname},"\x2D");
$heapa = substr($DBFIELD{$fname},0,$dindx);
$heapb = substr($DBFIELD{$fname},($dindx +
1),(length($DBFIELD{$fname}) -
$dindx));
$DBFIELD{$fname} = join("",$heapa,$heapb);
}
#Decimail > 0 and input has decimal point
#Does it already have a decimal point?
if((index($DBFIELD{$fname},".") ne -1) and (ord($fdecimal) ne 0))
{
$at = index($DBFIELD{$fname},".");
$whole = substr($DBFIELD{$fname},0,$at);
$frac = substr($DBFIELD{$fname},($at + 1),(length($DBFIELD{$fname})
- $at));
#Not enough decimal points, add more
if(length($frac) < ord($fdecimal))
{
$fcount = length($frac);
do
{
$frac = join("",$frac,chr(48));
$fcount++;
} until $fcount eq ord($fdecimal);
}
#Too many decimal points, remove some
if(length($frac) > ord($decimal))
{
$frac = substr($frac,0,ord($fdecimal));
}
$wmax = ord($flength) - (length($frac) + 1);
#Need 0x20 padding before start of number
if(length($whole) < $wmax)
{
$wcount = length($whole);
do
{
$whole = join("","\x20",$whole);
$wcount++;
} until $wcount eq $wmax;
}
#Number too long, needs truncating
if(length($whole) > $wmax)
{
$whole = substr($whole,(length($whole) - $wmax),$wmax);
}
#Dump the stack and we are done!
$dstack = join("",$dstack,$whole,".",$frac);
}
#Decimal > 0 and input has NO decimal point
elsif(ord($fdecimal) ne 0)
{
#Add decimal point, pad with zeros
$wmax = ord($flength) - (ord($fdecimal) + 1);
#Number not long enough, needs 0x20 padding added
if(length($DBFIELD{$fname}) < $wmax)
{
$padlen = ord($flength) - (length($DBFIELD{$fname}) +
ord($fdecimal) +
1);
$heap = "";
$dcount = 0;
do
{
$heap = join("",$heap,"\x20");
$dcount++;
} until $dcount eq $padlen;
$heap = join("",$heap,$DBFIELD{$fname},".");
$dcount = 0;
do
{
$heap = join("",$heap,"0");
$dcount++;
} until $dcount eq ord($fdecimal);
}
#Number too long, needs truncating
elsif(length($DBFIELD{$fname}) > $wmax)
{
$heap = substr($DBFIELD{$fname},(length($DBFIELD{$fname}) -
$wmax),$wmax);
$heap = join ("",$heap,".");
$dcount = 0;
do
{
$heap = join("",$heap,"0");
$dcount++;
} until $dcount eq ord($fdecimal);
}
#Number is the exact right lenght, no padding
else
{
$heap = join("",$DBFIELD{$fname},".");
$dcount = 0;
do
{
$heap = join("",$heap,"0");
$dcount++;
} until $dcount eq ord($fdecimal);
}
#Dump the stack and we are done!
$dstack = join("",$dstack,$heap);
}
#Decimal = 0 length
else
{
#Number has a decimal place that needs dropping
if(index($DBFIELD{$fname},".") ne -1)
{
$at = index($DBFIELD{$fname},".");
$heap = substr($DBFIELD{$fname},0,$at);
#Number not long enough, needsing padding
if (length($heap) < ord($flength))
{
$dcount = length($heap);
do
{
$heap = join("","\x20",$heap);
$dcount++;
} until $dcount eq ord($flength);
}
#Number exact lenght or over, needs truncating
else
{
$heap = substr($heap,(length($heap) -
ord($flength)),ord($flength));
}
}
#Nubmer has NO deicmal point to remove
else
{
$heap = $DBFIELD{$fname};
#Number not long enough, needs 0x20 padding
if (length($heap) < ord($flength))
{
$dcount = length($heap);
do
{
$heap = join("","\x20",$heap);
$dcount++;
} until $dcount eq ord($flength);
}
#Number exact lenght or over, needs truncating
else
{
$heap = substr($heap,(length($heap) -
ord($flength)),ord($flength));
}
}
#Dump the stack and we are done!
$dstack = join("",$dstack,$heap);
}
}
#Memo data
elsif($ftype eq "M")
{
$memos++;
#Limit memos to 64Kbytes of data! (16 bit address limits)
if(length($DBFIELD{$fname}) > 64500)
{
$MSTACK{$memos} = substr($DBFIELD{$fname},0,64500);
}
else
{
$MSTACK{$memos} = $DBFIELD{$fname};
}
#Create DBT stack
#next memo header
$dbtstack = join("",$dbtstack,"\xff\xff\x08\x00");
#Memo lenght chopped to 16 bits, other half 0x00 padded
$mbyte2 = "\x00";
$mlen = length($MSTACK{$memos}) + 8;
if($mlen > 256)
{
$mbyte2 = int($mlen / 256);
$mlen = $mlen - ($mbyte2 * 256);
}
$dbtstack = join("",$dbtstack,chr($mlen),chr($mbyte2),"\x00\x00");
#Add memo data to stack
$dbtstack = join("",$dbtstack,$MSTACK{$memos});
#Calculate number of blocks used
$mblocks = int((length($MSTACK{$memos}) + 8) / 512);
if(($mblocks * 512) < (length($MSTACK{$memos}) + 8)) { $mblocks++; }
#Add 0x00 padding to last block
$pad = ($mblocks * 512) - (length($MSTACK{$memos}) + 8);
if($pad > 0)
{
$ploop = 0;
do
{
$dbtstack = join("",$dbtstack,"\x00");
$ploop++;
} until $ploop eq $pad;
}
#Set MBLOCK and blocks to track blocks for DBF and DBT creation
$MBLOCK{$memos} = $blocks + 1;
$blocks = $blocks + $mblocks;
#Prevent system from using more than 65536 blocks! WAY too much data
at that point!
if($blocks > 65535) { death("Too many memo blocks! over 65535 blocks
of 512 bytes! (over 32
Megs!)",3,1340); }
#Create dstack data for DBF OUT file
$pad = 10 - length($MBLOCK{$memos});
$dheap = $MBLOCK{$memos};
if($pad > 0)
{
$ploop = 0;
do
{
$dheap = join("","\x20",$dheap);
$ploop++;
} until $ploop eq $pad;
}
$dstack = join("",$dstack,$dheap);
}
#Char or other data
else
{
$dheap = substr($DBFIELD{$fname},0,ord($flength));
if(length($dheap) < ord($flength))
{
$dcount = length($dheap);
do
{
$dheap = join("",$dheap,"\x20");
$dcount++;
} until $dcount eq ord($flength);
}
$dstack = join("",$dstack,$dheap);
}
}
} until $dbrcount eq ($dbrbytes - 1);
close(DBREF);
#Get Time & Drop Dir loop, try 5 times then give up! - Fix for parallel
runs
$doit = 0;
do
{
#Get current date/time info for file names and reporting
($lsec,$lmin,$lhour,$lmday,$lmon,$lyear,$lwday,$lyday,$lisdst) =
localtime;
$lmon++;
$nowlocal = localtime;
$nowgmt = gmtime;
#Pad single digit numbers with a zero
if(length($lsec) eq 1) { $lsec = join("","0",$lsec); }
if(length($lmin) eq 1) { $lmin = join("","0",$lmin); }
if(length($lhour) eq 1) { $lhour = join("","0",$lhour); }
if(length($lmday) eq 1) { $lmday = join("","0",$lmday); }
if(length($lmon) eq 1) { $lmon = join("","0",$lmon); }
#Creat DB drop dir name
$dump_dir = join("","IMPORT DB DATE ",($lyear +
1900),"-",$lmon,"-",$lmday," TIME ",$lhour,"-",$lmin,"-",$lsec);
$dump_path = join("",$regdd,$dump_dir);
#Try to make DB drop dir
$nodump = 0;
mkdir($dump_path) or $nodump = 1;
if($nodump eq 0) { $doit = 5; }
#Could not make drop dir, idle for a bit then try again.
if($doit < 5)
{
$tryout++;
$idle = time;
do { $wastecpu = time; } until $wastecpu ne $idle;
}
$doit++;
} until $doit > 4;
#Error out if no dump dir was created
if($nodump eq 1) { death("Could not make dump dir: $dump_path",2,1350);
}
#Track parallel runs, record as warning in event logs
if($tryout > 0)
{
$conflicts =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\conflicts$formdb"}
or
death("Can't open registry for conflict stats!!",3,1352);
$conflicts++;
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\conflicts$formdb"}
= $conflicts or
death("Can't write to registry for conflict stats!!",3,1354);
$Event = Win32::EventLog->new("Application") or death("Could not open
NT Event Log for conflict
report!!",3,1356);
$Event->Report(
{
Source => "FormDB",
EventID => "2",
Strings => "$ver_tag\x0D\x0A$copy_tag\x0D\x0A\x0D\x0AA conflict
occurred due to multiple instances of FormDB
in memory. The conflict was resolved, this warning is only for tracking
purposes.\x0D\x0ANumber of retries =
$tryout\x0D\x0A\x0D\x0AE-Mail Address: $DBFIELD{$emfd}\x0D\x0AIP
Address: $ENV{'REMOTE_HOST'}\x0D\x0ABrowser:
$ENV{'HTTP_USER_AGENT'}\x0D\x0A\x0D\x0A$rdinfo\x0D\x0ARun Count =
$runcount\x0D\x0AGood Count =
$good\x0D\x0AWarning Count = $wrn\x0D\x0AError Count =
$ers\x0D\x0AConflict Count = $conflicts\x0D\x0A",
EventType => EVENTLOG_WARNING_TYPE,
}
) or death("Could not write to NT Event Log for conflict
report!!",3,1358);
}
#Create $DBF data stream for file output
#
#Generate 32 byte header for OUT DBF
#Starts with 0x8B for dBaseIV with memo file
$DBF = "\x8B";
#Generate 3 byte file date
$DBF = join("",$DBF,chr($lyear),chr($lmon + 1),chr($lmday));
#Number of records, always 01 00 00 00 for FormDB
$DBF = join("",$DBF,"\x01\x00\x00\x00");
#Create 16 bit length for header
$hlen = length($fstack) + 33;
if($hlen > 256)
{
$hbyte2 = int($hlen / 256);
$hstack = $hlen - ($hbyte2 * 256);
$hlen = $hstack;
}
$DBF = join("",$DBF,chr($hlen),chr($hbyte2));
#Create 16 bit length for record
$rlen = length($dstack) + 1;
if($rlen > 256)
{
$rbyte2 = int($rlen / 256);
$rstack = $rlen - ($rbyte2 * 256);
$rlen = $rstack;
}
$DBF = join("",$DBF,chr($rlen),chr($rbyte2));
#Fill in 20 bytes of 0x00 padding
$DBF =
join("",$DBF,"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00");
#Dump field stack
$DBF = join("",$DBF,$fstack);
#Terminate field header area, start data area
$DBF = join("",$DBF,"\x0d\x20");
#Dump data stack
$DBF = join("",$DBF,$dstack);
#Close out DBF
$DBF = join("",$DBF,"\x1a");
#clean up memory used to create DBF data stream
undef $fstack;
undef $dstack;
#Create $DBT data stream for file output
#
#Write header to DBT OUT
#Calculate next available 512 byte block in DBT OUT file (chopped to 16
bits)
$nbyte2 = "\x00";
$bnext = $blocks + 1;
if($bnext > 256)
{
$nbyte2 = int($bnext / 256);
$nstack = $bnext - ($nbyte2 * 256);
$bnext = $nstack;
}
$DBT = join("",chr($bnext),chr($nbyte2),"\x00\x00");
#Write out 16 bytes of 0x00 padding
$DBT =
join("",$DBT,"\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00");
#Select 512 bytes block size
$DBT = join("",$DBT,"\x00\x02");
#Write out 490 bytes of 0x00 padding to close out header, total 512
byte header
$hloop = 0;
$pad = "";
do
{
$pad = join ("",$pad,"\x00");
$hloop++;
} until $hloop eq 490;
$DBT = join("",$DBT,$pad);
#Dump DBT stack to DBT OUT
$DBT = join("",$DBT,$dbtstack);
#Clean up memory used to create DBT data stream
undef $dbtstack;
#Write DBF OUT file
$dump_dbf = join("",">",$dump_path,"\\Import.dbf");
open(DBFOUT,$dump_dbf) or death("Could not open DBF OUT during DB
create! Path: $dump_path",2,1360);
binmode(DBFOUT) or death("Could not set BIN mode on DBF OUT during DB
create! Path: $dump_path",2,1370);
print DBFOUT $DBF or death("Could not write to DBF OUT during DB
create! Path: $dump_path",2,1380);
close(DBFOUT);
#Wrtie DBT OUT file for memos
$dump_dbt = join("",">",$dump_path,"\\Import.dbt");
open(DBTOUT,$dump_dbt) or death("Could not open DBT OUT during DB
create! Path: $dump_path",2,1390);
binmode(DBTOUT) or death("Could not set BIN mode on DBT OUT during DB
create! Path: $dump_path",2,1400);
print DBTOUT $DBT or death("Could not write to DBT OUT during DB
create! Path: $dump_path",2,1410);
close(DBTOUT);
#Copy ref.adx to dump dir as import.adx
$dump_adx = join("",$dump_path,"\\Import.adx");
copy ($refadx,$dump_adx) or death("Could not copy REF ADX! Path:
$dump_path",2,1420);
#Create E-Mail Message Body
foreach $part (sort(keys (%COMMENT))) { $message =
join("\n",$message,$COMMENT{$part}); }
$goodmsg = $good + 1;
$message = join("",$message,"\n\n","Import for: $dbname (FormDb
#$formdb)\n","Import Directory Named:
",$dump_dir,"\n\n");
$message = join("",$message,"E-Mail Addrress: $DBFIELD{$emfd}\nIP
Addrress: $ENV{'REMOTE_HOST'}\nWeb Browser:
$ENV{'HTTP_USER_AGENT'}\n\n");
$message = join("",$message,$rdinfo,"\nSTATS: RunCount = $runcount -
Good = $goodmsg - Warning = $wrn - Error = $ers -
Conflicts = $conflicts\n\n");
$message = join("",$message,$ver_tag,"\n",$copy_tag,"\n");
#Send email to SMTP server
$result =
sendmail($DBFIELD{$emfd},$DBFIELD{$emfd},$email_to,$smtpserv,$email_subject,$message);
if ($result < 1) { death("SMTP Server error code $result during
send!!",2,1430); }
#Redirect client browser to returnpage_url
print "Location: $returnpage_url\n\n";
#DEBUG LINE - Test NT Event Logg!! - NEW METHOD
#Win32::EventLog::Message::RegisterSource( $SourceLog, $PerlSource );
#Needs to be run once as Admin to register
source on server
$goodevt = $good + 1;
$Event = Win32::EventLog->new("Application") or death("Could not open
NT Event Log for Info Report!!",3,1440);
$Event->Report(
{
Source => "FormDB",
EventID => "1",
Strings => "$ver_tag\x0D\x0A$copy_tag\x0D\x0A\x0D\x0A- Web Form
was successfuly processed for:\x0D\x0A$dbname
(FormDB #$formdb)\x0D\x0A- Stored in
directory:\x0D\x0A$dump_dir\x0D\x0A\x0D\x0AE-Mail Address:
$DBFIELD{$emfd}\x0D\x0AIP Address: $ENV{'REMOTE_HOST'}\x0D\x0ABrowser:
$ENV{'HTTP_USER_AGENT'}\x0D\x0A\x0D\x0A$rdinfo\x0D\x0ARun Count =
$runcount\x0D\x0AGood Count =
$goodevt\x0D\x0AWarning Count = $wrn\x0D\x0AError Count =
$ers\x0D\x0AConflict Count = $conflicts\x0D\x0A",
EventType => EVENTLOG_INFORMATION_TYPE,
}
) or death("Could not write to NT Event Log for Info Report!!",3,1450);
#DEBUG LINE - Test NT Registry access - for storing run time stats
$good =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\good$formdb"}
or death("Can't open
registry for good stat!!",3,1460);
$good++;
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\good$formdb"}
= $good or death("Can't write to
registry for good stats!!",3,1470);
#ALL DONE, EXIT RUN TIME
exit;
###########################################################
# Custom tweaked version of my sendmail sub. Has MIME strings!
#
# Error codes returned by sendmail:
# 1 success (yeah!!!)
# -1 $smtphost unknown
# -2 socket() failed
# -3 connect() failed
# -4 service not available
# -5 unspecified communication error
# -6 local user $to unknown on host $smtp
# -7 transmission of message failed
# -8 argument $fromaddr empty
# -9 argument $replyaddr empty
# -10 argument $to empty
# -11 argument $smtp empty
# -12 argument $subject empty
# -13 argument $message empty
#
# Sample call:
#
# &sendmail($from, $reply, $to, $smtp, $subject, $message );
#
sub sendmail {
#read in passed variables
my ($fromaddr, $replyaddr, $to, $smtp, $subject, $message) = @_;
#format data for SMTP session
$to =~ s/[ \t]+/, /g; # pack spaces and add comma
$fromaddr =~ s/.*<([^\s]*?)>/$1/; # get from email address
$replyaddr =~ s/.*<([^\s]*?)>/$1/; # get reply email address
$replyaddr =~ s/^([^\s]+).*/$1/; # use first address
$message =~ s/^\./\.\./gm; # handle . as first character
$message =~ s/\r\n/\n/g; # handle line ending
$message =~ s/\n/\r\n/g;
$smtp =~ s/^\s+//g; # remove spaces around $smtp
$smtp =~ s/\s+$//g;
#check all fields for valid data
if (!$fromaddr)
{
return(-8);
}
if (!$replyaddr)
{
return(-9);
}
if (!$to)
{
return(-10);
}
if (!$smtp)
{
return(-11);
}
if (!$subject)
{
return(-12);
}
if (!$message)
{
return(-13);
}
#setup variables needed to open socket connection
my($proto) = (getprotobyname('tcp'))[2];
my($port) = (getservbyname('smtp', 'tcp'))[2];
my($smtpaddr) = ($smtp =~
/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/)
? pack('C4',$1,$2,$3,$4)
: (gethostbyname($smtp))[4];
#check to make sure $smtpaddr was created
if (!defined($smtpaddr))
{
return(-1);
}
#grab socket for connection
if (!socket(MAIL, AF_INET, SOCK_STREAM, $proto))
{
return(-2);
}
#establish connection to SMTP server
if (!connect(MAIL, pack('Sna4x8', AF_INET, $port, $smtpaddr)))
{
return(-3);
}
my($oldfh) = select(MAIL);
$| = 1;
select($oldfh);
#return error if SMTP service doesn't respond or blocks connection
$_ = <MAIL>;
if (/^[45]/)
{
close(MAIL);
return(-4);
}
#say hello to server, return error if connection refused
print MAIL "helo $SMTP_SERVER\r\n";
$_ = <MAIL>;
if (/^[45]/)
{
close(MAIL);
return(-5);
}
#tell server who message is from, return error if connection refused
print MAIL "mail from: <$fromaddr>\r\n";
$_ = <MAIL>;
if (/^[45]/)
{
close(MAIL);
return(-5);
}
#tell server who to send message to, split for more than one address,
return error if invalid to: address on server
foreach (split(/, /, $to))
{
print MAIL "rcpt to: <$_>\r\n";
$_ = <MAIL>;
if (/^[45]/)
{
close(MAIL);
return(-6);
}
}
#tell server we are ready to send the message header and body
print MAIL "data\r\n";
$_ = <MAIL>;
if (/^[45]/)
{
close MAIL;
return(-5);
}
#generate header data and send message contents to server - Modified
for multipart mime!
print MAIL "From: <$fromaddr>\n";
print MAIL "Reply-to: <$replyaddr>\n" if $replyaddr;
print MAIL "To: <$to>\n";
print MAIL "X-Mailer: <SendMail Routine, Verison 1.3 - T.E.A.M.
Work Software 2003 - www.teamworkweb.com>\n";
print MAIL "X-Script: <$ver_tag - $copy_tag>\n";
print MAIL "X-Sender: <$fromaddr>\n";
print MAIL "X-RCPT-TO: <$to>\n";
print MAIL "Subject: $subject\n\n";
print MAIL "$message";
print MAIL "\n.\n";
#check to see if message send failed, return error if so
$_ = <MAIL>;
if (/^[45]/)
{
close(MAIL);
return(-7);
}
#if send was ok, close connection to SMTP server and return sucess code
print MAIL "quit\r\n";
$_ = <MAIL>;
close(MAIL);
return(1);
}
#################################################
#Custom death() sub for FormDB error reporting
#
# Error levels:
# 1 - User input error
# 2 - Error
# 3 - Fatal Error
sub death {
my($errmsg,$errlvl,$chkpnt) = @_;
#DEBUG LINE - Test NT Registry access - for storing run time stats
#DEBUG LINE - Test NT Event Log!! - NEW METHOD
if($errlvl eq 1)
{
$wrn =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\warning$formdb"};
$wrn++;
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\warning$formdb"}
= $wrn;
$Event = Win32::EventLog->new("Application");
$Event->Report(
{
Source => "FormDB",
EventID => "2",
Strings => "$ver_tag\x0D\x0A$copy_tag\x0D\x0A\x0D\x0A- Error
with form for:\x0D\x0A$dbname
(FormDB #$formdb)\x0D\x0A\x0D\x0AUser Input Error.\x0D\x0ALevel=
$errlvl - Check Point=
$chkpnt\x0D\x0A$errmsg\x0D\x0A\x0D\x0AE-Mail Address:
$DBFIELD{$emfd}\x0D\x0AIP Address:
$ENV{'REMOTE_HOST'}\x0D\x0ABrowser:
$ENV{'HTTP_USER_AGENT'}\x0D\x0A\x0D\x0A$rdinfo\x0D\x0ARun Count =
$runcount\x0D\x0AGood Count = $good\x0D\x0AWarning Count =
$wrn\x0D\x0AError Count = $ers\x0D\x0AConflict Count =
$conflicts\x0D\x0A",
EventType => EVENTLOG_WARNING_TYPE,
}
);
}
else
{
$ers =
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\error$formdb"};
$ers++;
$Registry->{"HKEY_LOCAL_MACHINE\\Software\\TeamWork\\FormDB\\\\error$formdb"}
= $ers;
#Decide if it's a regular error or a fatal error
if($errlvl eq 2) { $errword = "Error"; } else { $errword = "Fatal
Error"; }
$Event = Win32::EventLog->new("Application");
$Event->Report(
{
Source => "FormDB",
EventID => "3",
Strings => "$ver_tag\x0D\x0A$copy_tag\x0D\x0A\x0D\x0A- Error
with form for:\x0D\x0A$dbname
(FormDB #$formdb)\x0D\x0A\x0D\x0A$errword processing web
form.\x0D\x0ALevel= $errlvl - Check Point=
$chkpnt\x0D\x0A$errmsg\x0D\x0A\x0D\x0AE-Mail Address:
$DBFIELD{$emfd}\x0D\x0AIP Address:
$ENV{'REMOTE_HOST'}\x0D\x0ABrowser:
$ENV{'HTTP_USER_AGENT'}\x0D\x0A\x0D\x0A$rdinfo\x0D\x0ARun Count =
$runcount\x0D\x0AGood Count = $good\x0D\x0AWarning Count =
$wrn\x0D\x0AError Count = $ers\x0D\x0AConflict Count =
$conflicts\x0D\x0A",
EventType => EVENTLOG_ERROR_TYPE,
}
);
}
#Send http header to client browser
print "Content-Type: text/html\n\n";
#Send HTML header to client browser
print <<errhtml;
<html><title>Error Processing Form</title>
<meta name="Error Info" content="MSG= $errmsg,LVL= $errlvl,CHK=
$chkpnt">
<body><br><br><br>
<center><table width=600><tr><td>
<h2>We are sorry,<br> there was an error processing the form you
submitted.</h2><br>
errhtml
#Send error web page to client browser, choose based on errlvl
if ($errlvl eq 1) {
print <<errhtml;
<p>
A required piece of information was not found in your form. It is
possible that a required field was left
blank, or contained invalid data. Please hit the back button in your
browser and double check the form
for any missing information. All fields that require your input are
marked with asterisks(*).
Please also make sure a valid e-mail address has been entered.
<br><br>
If you have already received this error message, and you have double
checked the form and found no problems,
it is possible our software is having a problem. Please contact us so
we can assist you better. You can
find our contact information by <a href="$errlink">clicking here.</a>
errhtml
}
elsif ($errlvl eq 2) {
print <<errhtml;
<p>
There was an error sending your form through our server. We apologize
for this problem, please try hitting
the back button on your browser and resubmitting the form. If you get
this error message again there is
currently a problem with our server and we will not be able to process
your form at this time. Please contact
us so we can assist you better. You can find our contact information
by <a href="$errlink">clicking here.</a>
errhtml
}
elsif ($errlvl eq 3) {
print <<errhtml;
<p>
There appears to be an error in our on-line form. We apologize for
this, but we will be unable to process your
form at this time. Please contact us so we can assist you better. You
can find our contact information by <a
href="$errlink">clicking here.</a>
errhtml
}
else {
print <<errhtml;
<p>
There was a general error processing your form. We apologize for this
problem, please try hitting
the back button on your browser and resubmitting the form. If you get
this error message again there is
currently a problem with our server and we will not be able to process
your form at this time. Please contact
us so we can assist you better. You can find our contact information
by <a href="$errlink">clicking here.</a>
errhtml
}
print <<errhtml;
</td></table></center></body></html>
errhtml
exit;
}
------------------------------
Date: Tue, 10 Oct 2006 16:04:53 -0700
From: Jim Gibson <jgibson@mail.arc.nasa.gov>
Subject: Re: Eliminating required fields in perl script for iis 6.0 server
Message-Id: <101020061604534086%jgibson@mail.arc.nasa.gov>
In article <1160518240.305182.27690@b28g2000cwb.googlegroups.com>,
<birdfludeathclock@yahoo.com> wrote:
> Hello Group,
>
> I am trying to figure out how I can eliminate the required fields
> section in a perl script that is posted from a form. We do not want
> the user that fills in the web form to have any mandatory fields that
> he/she must fill out. All fields should be optional. I've tried to
> tackle this problem myself but can not seem to get it to work. It
> doesn't help to not be much of a programmer. I have included the .pl
> script below
It is very unlikely that anyone is going to go through your 1290-line
program and figure out what is wrong with it, at least not without
getting paid for it. It is your job to figure out the logic of your
program, although there are many very helpful people here who can
explain the intricacies of Perl for you.
[snip ~160 lines]
> #Is it a required field? (marked !...)
> if(index($name,"!") eq 0)
> {
> if(length($data) eq 0) { $required_miss = 1; last SWITCH; }
Here you set a variable $required_miss to 1.
[snip ~60 lines]
> #End of parse code block
>
> #Check error traps
> if($required_miss eq 1) { death("Required field $name empty!",1,1020);
And here you terminate processing if $required_miss is 1 (and also note
that the program is using the wrong operator to test $required_miss --
it should be 'if( $required_miss == 1 )' or just 'if( $required_miss
)'.
So I would inspect those lines that set $required_miss to 1 and perhaps
not set it at all.
Note that there many other things wrong with this program. You should
hire a professional Perl programmer to fix it.
Posted Via Usenet.com Premium Usenet Newsgroup Services
----------------------------------------------------------
** SPEED ** RETENTION ** COMPLETION ** ANONYMITY **
----------------------------------------------------------
http://www.usenet.com
------------------------------
Date: Tue, 10 Oct 2006 14:30:21 -0500
From: brian d foy <brian.d.foy@gmail.com>
Subject: Re: FAQ 4.22 How do I expand function calls in a string?
Message-Id: <101020061430214287%brian.d.foy@gmail.com>
In article <4iirv3-gs1.ln1@osiris.mauzo.dyndns.org>, Ben Morrow
<benmorrow@tiscali.co.uk> wrote:
> > 4.22: How do I expand function calls in a string?
> > print "The time is ${\(scalar localtime)}.\n"
> >
> > print "The time is ${ my $x = localtime; \$x }.\n";
> Is it worth the FAQ pointing out that
>
> print "Foo is: ${\( foo )}.\n";
>
> still calls foo in *list* context?
I've noted that by explaining the presence of scalar in that example.
Thanks,
--
Posted via a free Usenet account from http://www.teranews.com
------------------------------
Date: Tue, 10 Oct 2006 19:39:38 GMT
From: Charles DeRykus <ced@blv-sam-01.ca.boeing.com>
Subject: Re: Help with test program
Message-Id: <J6xqM1.4ty@news.boeing.com>
Peter J. Holzer wrote:
> On 2006-10-08 20:47, joubertb@gmail.com <joubertb@gmail.com> wrote:
>> I have been working on this for the past few days and still can't
>> figure out what I am doing wrong.
>> ===========================< cut here >===============================
>>
>> package foobar;
> [...]
>> sub func {
>> my $self = shift;
>> my $param = shift;
>> print "inside function\n";
>>
>> print "param=$param\n";
>>
>> return "zzzzz";
>> }
>>
>>
>> $f = new foobar;
>>
>> my %myarray = (
>> foo => { func => $f->func, }
>> );
>> #
>> # When I do the above assignment, it calls the method $f->func.
>
> Yes.
>
>> # What I
>> # want it to do is assign the
>> # function pointer to func so that below I can call it.
>> #
>>
>> #$myarray{foo}{func};
>> $xxx = $myarray{foo}{func}("abc123");
>
> If you want to call it like this (i.e., you don't want to call func on
> any object, but always on $f), the best way is probably:
>
> my %myarray = (
> foo => { func => sub { $f->func(@_) }, }
> );
>
> if you want to be able to call func on arbitrary objects, I'd just store
> the name and let perl find the right method at call time:
>
> my %myarray = (
> foo => { func => 'func', }
> );
>
> my $f2 = new foobar;
> my $func = $myarray{foo}{func};
> $xxx = $f2->$func("abc123");
>
> There are other ways ...
>
The OP may want to take a look at the "Creating References to Methods"
and "Calling Methods Indirectly" recipes in the "Perl Cookbook" for some
further background.
The recipe has an explanation of why 'can' is unlikely to do what you
want since object context is lost. Yet something like this appears to
work and retains object context partially.
my %myarray = ( foo => { func => $f->can('func') } );
my $funcptr = $myarray{foo}{func};
my $xxx = $f->$funcptr("abc123");
If @ISA were changed, the recommended method would pick up the change;
whereas, the 'can' solution wouldn't. But,if @ISA remains intact,
can anyone cite possible flaws with the 'can' ref...?
--
Charles DeRykus
------------------------------
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 9830
***************************************
