[17754] in Perl-Users-Digest
Perl-Users Digest, Issue: 5174 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Dec 21 18:10:38 2000
Date: Thu, 21 Dec 2000 15:10:18 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <977440218-v9-i5174@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Thu, 21 Dec 2000 Volume: 9 Number: 5174
Today's topics:
Re: if i send an e-mail <rui.miguel@srd.alcatel.pt>
Is there a standard, current Perl for Win32 (without Ac <nagle@animats.com>
Re: Language evolution C->Perl->C++->Java->Python (Is P <kenny@kennypearce.net>
Re: matching the previous line nobull@mail.com
Need help with substitution: $HTML =~ s/\$(\w+)/${$1}/g <bobsummers@americasm97.nt.com>
Net::SNMP/POSIX namespace probs <missing@wam.umd.edu>
netiquette checking script (Tom Christiansen)
Re: netiquette checking script (Jerome O'Neil)
Re: netiquette checking script (Richard Zilavec)
Perl on Win32 from a unix guy. dnay@vbs.net
Re: Perl on Win32 from a unix guy. <brondsem@my-deja.com>
Re: Perl on Win32 from a unix guy. <mothra@nowhereatall.com>
Re: Perl on Win32 from a unix guy. <ddunham@redwood.taos.com>
Re: Perl on Win32 from a unix guy. <jhelman@wsb.com>
regexp question <robert@no-spam.basil.com>
Re: regexp question <jhelman@wsb.com>
Searching for a Value in an Array to remove <!spammed@aye.net!>
Re: Searching for a Value in an Array to remove (Richard Zilavec)
Re: Searching for a Value in an Array to remove <jhelman@wsb.com>
Re: Searching for a Value in an Array to remove <!spammed@aye.net!>
Re: Searching for a Value in an Array to remove (Richard Zilavec)
Sorting hash bkesuma@yahoo.com
Re: very strange thing with closures <russ_jones@rac.ray.com>
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 21 Dec 2000 21:04:32 +0000
From: Rui Miguel Venancio <rui.miguel@srd.alcatel.pt>
Subject: Re: if i send an e-mail
Message-Id: <3A427060.7F1180DE@srd.alcatel.pt>
--------------45D817BD7647C16C88F1A417
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 8bit
I am using the following Program.
Try it:
#!/usr/local/bin/perl
@input=("bla bla bla ") ; #Message Body
@users=(email addresses); #Email adressess
open (MAIL, "| mail @users") || die "Can't call sendmail";
$oldhandle = select MAIL;
print "To: SMS\@center.pt \n"; # The Persons you would like to send
the email
print "From: Me \n"; #Your email address
print "Subject: Bom Natal \n";
print "\n";
print "@input \n"; # The body message
close(MAIL);
select $oldhandle;
If you need more help you can ask.
Best regards and Merry Christmas.
Rui Venāncio
carlo costa wrote:
> Hi There,
>
> I am sorry to bother you, but i have a problem and I do not menage to get
> out of it,
>
> I am trying to send a-mail in a perl program,
>
> can you spend few lines to explain me how can I sand an e-mail in a perl
> program (I am looking for a module witch allow me to send without inserting
> any SMPT server)... please, telme where I can find some exemples or
> something to read about .
>
> I am sorry but I just started programming in perl and I need to solve this
> problem.
>
> Thanx
>
> B. W.
>
> Carlo
--
**************************************************************************
Rui Miguel Venancio Phone: +351 21 485 9671 Mobile: +351 93 370 0089
Alcatel Engineering & Integration Team / Skysoft Portugal Consultant
**************************************************************************
--------------45D817BD7647C16C88F1A417
Content-Type: text/html; charset=us-ascii
Content-Transfer-Encoding: 7bit
<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
I am using the following Program.
<p>Try it:
<br>
<br>
<br>
<p>#!/usr/local/bin/perl
<p>@input=("bla bla bla ") ; #Message Body
<br>@users=(email addresses); #Email adressess
<p>open (MAIL, "| mail @users") || die "Can't call sendmail";
<br> $oldhandle = select MAIL;
<br>
<br> print "To: SMS\@center.pt \n";
# The Persons you would like to send the email
<br> print "From: Me \n";
#Your email address
<br> print "Subject: Bom Natal \n";
<br> print "\n";
<br> print "@input \n";
# The body message
<br> close(MAIL);
<br>
<br> select $oldhandle;
<br>
<p>If you need more help you can ask.
<p>Best regards and Merry Christmas.
<p>Rui Venâncio
<br>
<p>carlo costa wrote:
<blockquote TYPE=CITE>Hi There,
<p> I am sorry to bother you, but i have a problem and I do not menage
to get
<br>out of it,
<p> I am trying to send a-mail in a perl program,
<p> can you spend few lines to explain me how can I sand an e-mail
in a perl
<br>program (I am looking for a module witch allow me to send without inserting
<br>any SMPT server)... please, telme where I can find some exemples or
<br>something to read about .
<p> I am sorry but I just started programming in perl and I need to
solve this
<br>problem.
<p> Thanx
<p> B. W.
<p> Carlo</blockquote>
<pre>--
**************************************************************************
Rui Miguel Venancio Phone: +351 21 485 9671 Mobile: +351 93 370 0089
Alcatel Engineering & Integration Team / Skysoft Portugal Consultant
**************************************************************************</pre>
</html>
--------------45D817BD7647C16C88F1A417--
------------------------------
Date: Thu, 21 Dec 2000 12:26:02 -0800
From: John Nagle <nagle@animats.com>
Subject: Is there a standard, current Perl for Win32 (without ActivePerl?)
Message-Id: <3A42675A.C80354F4@animats.com>
Is there a current, standard version of Perl for Win32? By this I
mean one without all the "ActivePerl/Active-X/Internet Explorer
scripting" crap in it? The only non-ActivePerl binary distributions
at CPAN seem to be either old versions or have a built-in Apache server.
John Nagle
Animats
------------------------------
Date: Thu, 21 Dec 2000 12:43:33 -0800
From: Kenny Pearce <kenny@kennypearce.net>
Subject: Re: Language evolution C->Perl->C++->Java->Python (Is Python the ULTIMATE oflanguages??)
Message-Id: <3A426B75.1481B8BA@kennypearce.net>
Hakan Stenholm wrote:
> Kenny Pearce wrote:
>
> > I haven't used SmallTalk, but from this conversation it seems that the only difference
> > between "everything is an object" and having primitives is that the latter requires
> > less typing. Ex.
> > int x =1;
> > as opposed to
> > Integer x = new Integer(1);
> >
> > I can't c y there would be any other difference...
>
> There are a few problems / inconsistencies / faults that result from not dealing with
> everything as object:
> * basic types like inf, float, char ... can't be inherited from, i.e. if you need to
> build new math functionality e.g. complex numbers ... you will have to build a new class
> that implements all +,-,*,/ ... operators as methods (the operators can't be used as java
> doesn't support operator overloading) .
> * classes like Vector in java can only contain objects so you'll have to put basic types
> in wrapper classes and pull them out again to do calculations on them (javas basic type
> wrappers are pretty much limited to create and get functionality).
> * it's far simpler to build a sorter that can sort any kind of data item if all items are
> objects they simply need to support some kind of bigger_then(OtherElement) method.
it's not all that difficult to perform operation on wrapper classes (Integer, Boolean, etc.)
for example:
Integer int1 = new Integer(5);
Integer int2 = new Integer(3);
Integer int3;
int3 = new Integer(int1.intValue() - int2.intValue());
int3 now equals 2... fairly painless... a little extra typing, but it could perceivably make
things easier (or harder, I suppose) in the long run depending on what it is your trying to
do... Same with all the other classes which are wrappers for primitives...
------------------------------
Date: 21 Dec 2000 18:52:01 +0000
From: nobull@mail.com
Subject: Re: matching the previous line
Message-Id: <u9zohpy5da.fsf@wcl-l.bham.ac.uk>
ermichael@my-deja.com writes:
> The statement:
>
> if (/start/ .. /finish/)
>
> will match from the first line containing the string 'start' to a line
> containing finish inclusively. How do I match from the line
> containing 'start' to the line *immediately preceeding* the one that
> contains 'finish'?
Hmmm.. I don't know... but it's an interesting question... I'll go
RTFM on the .. operator... Hmmm... [ 5 minuites latter ] found the
bit where it tells you what to do "if you want to exclude the
endpoint".
Hmm... now that's interesting... I never new that...
Please do not treat newsgroups as an alternative to reading the
manual.
Fish follows. Please do not read it unless you promise to go fishing
yourself next time:
if ( my $seq = /start/ .. /finish/ and $seq !~ /E/ )
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Thu, 21 Dec 2000 15:24:57 -0500
From: "Summers, Bob [FITZ2:8m81:EXCH]" <bobsummers@americasm97.nt.com>
Subject: Need help with substitution: $HTML =~ s/\$(\w+)/${$1}/g;
Message-Id: <3A426719.C5FC4970@americasm97.nt.com>
I've have been successfully using CGI programs to call HTML template
files and substitute for variables that are hard coded along with the
rest of the HTML stuff. The script that I use is one of a number of
"template" cgi tricks out there to be able to add some dynamic content
to a HTML page.
The guts of the my script uses:
$HTML =~ s/\$(\w+)/${$1}/g;
to change all "$"variables into their corresponding values (eg, $subject
is changed into VALUE for $subject). This works great if the
"Template" subroutine is IN THE SAME cgi file so that the variables are
locally scoped.
However, I've been trying unsuccessfully to put the "Template"
subroutine into a common package but I can't seem to find the proper way
to reference the variables in the "main" cgi (eg, $main'subject). I
think I need something like:
$HTML =~ s/\$(\w+)/$main'{$1}/g;
but this doesn't work (gives me: '{subject}. Other variations give me
errors) If I just use the original substitution line with ${$1}, the
"value" of the variable $1 is not known.
Can anyone help me perform this ${$1}trick?
Thanks
Bob Summers
Ottawa, Ontario
Background
In CALLING CGI FILE::
print "Content-type: text/html\n\n";
print &template("my_htm_file.htm");
TEMPLATE SUBROUTINE
sub template {
local ($file) = $_[0]
open(FILE, "<$file") || die "Template: Couldn't open $file : $!\n";
while (<FILE>) { $HTML .= $_; }
close(FILE);
$HTML =~ s/\$(\w+)/${$1}/g;
return $HTML;
}
------------------------------
Date: Thu, 21 Dec 2000 16:15:56 -0500
From: missing <missing@wam.umd.edu>
Subject: Net::SNMP/POSIX namespace probs
Message-Id: <Pine.GSO.4.21.0012211552290.741-100000@rac4.wam.umd.edu>
The following pgm generates the listed errors. This is perl version
5.005_03 running on rh linux. Seems like I've got a namespace collision
w/ Exporter::import and POSIX::import both importing POSIX but I'm not
sure how to correct this since Net::SNMP doesn't 'use POSIX' and I'm
using POSIX in other pgms.
any hlp apprec.
-m
xbox:/home/mwi/devel :> cat ./main.pl
#!/usr/bin/perl -w
use Net::SNMP;
use POSIX;
xbox:/home/mwi/devel :> ./main.pl
Constant subroutine NULL redefined at
/usr/libdata/perl/5.00503/Exporter.pm line 157
Exporter::export('POSIX', 'main') called at
/usr/libdata/perl/5.00503/Exporter.pm line 182
Exporter::import('POSIX') called at
/usr/libdata/perl/5.00503/mach/POSIX.pm line 190
POSIX::import('POSIX') called at ./d.p line 3
main::BEGIN() called at /usr/libdata/perl/5.00503/mach/POSIX.pm line 3
eval {...} called at /usr/libdata/perl/5.00503/mach/POSIX.pm line 3
Prototype mismatch: sub main::NULL () vs none at
/usr/libdata/perl/5.00503/Exporter.pm line 157
Exporter::export('POSIX', 'main') called at
/usr/libdata/perl/5.00503/Exporter.pm line 182
Exporter::import('POSIX') called at
/usr/libdata/perl/5.00503/mach/POSIX.pm line 190
POSIX::import('POSIX') called at ./d.p line 3
main::BEGIN() called at /usr/libdata/perl/5.00503/mach/POSIX.pm line 3
eval {...} called at /usr/libdata/perl/5.00503/mach/POSIX.pm line 3
xbox:/home/mwi/devel :>
------------------------------
Date: 21 Dec 2000 13:13:34 -0700
From: tchrist@perl.com (Tom Christiansen)
Subject: netiquette checking script
Message-Id: <3a42646e@cs.colorado.edu>
We really need shared or cooperative {score,kill}files. I'm thinking
of some dynamic solution to the noiseboxes, maybe reminiscent of
Greg Bacon's periodic stats postings. I'll likely start with
something like this.
--tom
#!/usr/bin/perl -w
# msgchk - check news message for netiquette issues
# tchrist@perl.com
use strict;
my $Msg = get_message();
missing_headers();
bogus_address();
allcap_subject();
annoying_subject();
mimes();
lines_too_long();
control_characters();
miswrapped();
jeopardy_quoted();
overquoted();
good_signature();
exit(0);
#######################
sub AUTOLOAD {
use vars '$AUTOLOAD';
my $field;
($field = uc($AUTOLOAD)) =~ s/.*:://;
if (!defined wantarray) {
require Carp;
Carp::confess("Undefined function call: $AUTOLOAD");
}
$Msg->$field();
}
sub bogus_address {
my $address = from();
if ($address !~ /\@\w.*\.\w/) {
print "From address must contain an at sign, etc.\n";
return;
}
if ($address =~ /(remove|spam)/i) {
print "Munged return address suspected, found `$1' in from.\n";
}
ck822($address); # inscrutable
my($host) = $address =~ /\@([a-zA-Z0-9_.-]+)/;
dns_check($host); # very slow!
}
sub control_characters {
my $lineno = 0;
my $MAX_CONTROL = 5;
for (lines()) {
$lineno++;
if (/(?=[^\s\b])([\000-\037])/) {
printf "Control character (char %#o) appears at line %d of body.\n",
ord $1, $lineno;
}
if (/([\202-\237])/) {
printf "MS-ASCII character (char %#o) appears at line %d of body.\n",
ord $1, $lineno;
}
last if --$MAX_CONTROL < 0;
}
}
sub lines_too_long {
my $MAX_LINE_LEN = 80;
my $line_count = scalar @{ [ lines() ] };
my ($long_lines, $longest_line_data, $longest_line_number) = (0,'',0);
my $lineno = 0;
for (lines()) {
$lineno++;
next if /^[>+-]/; # skip quotes and patch diffs
if (length() > $MAX_LINE_LEN) {
$long_lines++;
if (length() > length($longest_line_data)) {
$longest_line_data = $_;
$longest_line_number = $lineno;
}
}
}
if ($long_lines) {
printf "%d of %d lines exceed maxlen %d, ",
$long_lines, $line_count, $MAX_LINE_LEN;
printf "longest is #%d at %d bytes\n",
$longest_line_number, length($longest_line_data);
}
}
sub missing_headers {
if (subject() !~ /\S/) {
print "Missing required subject header.\n";
}
if (newsgroups() && subject() =~ /^\s*Re:/i && !references()) {
print "Followup posting missing required references header.\n";
}
}
sub allcap_subject {
my $subject = subject();
$subject =~ s/^(\s*Re:\s*)+//i;
if ($subject !~ /[a-z]/) {
print "No lower-case letters in subject header.\n";
}
}
sub miswrapped {
my($bq1, $bq2);
for (paragraphs()) {
next unless /\A(^\S.*){2,}\Z/ms; # no indented code
if (!$bq1 && /^>\S.*\n\s*[a-zA-Z]/) {
print "Incorrectly wrapped quoted text.\n";
$bq1++;
}
next if $bq2;
my $count = 0;
while (/^[^>].{60,}\n[^>].{1,20}\n(?=[^>].{60,}\n)/gm) {
$count++;
}
if ($count > 1) {
print "Incorrectly wrapped regular text.\n";
$bq2++;
### print "OOPS count = $count:\n$_\n\n";
}
}
}
sub jeopardy_quoted {
local $_ = body();
$_ = unquote_wrap($_);
$_ = strip_signature($_);
$_ = strip_attribution($_);
# check quotation at bottom but nowhere else
# XXX: these can go superlong superlong! i've added
# some more anchors and constraints to try to avoid this,
# but I still mistrust it
if (/ ((^\s*>.*){2,}) \s* \Z/mx
&&
!/ (\n>.*?)+ (\n[^>].*?)+ (\n>.*?)+ /x )
{
print "Quote follows response, Jeopardy style #1\n";
}
# completely at bottom
elsif (/^.* wr(?:ote|ites):\n(>.*\n)+\s*\Z/m) {
print "Quote follows response, Jeopardy style #2\n";
}
# another way of saying the same
elsif (/^(?:>+\s*)?-[_+]\s*Original Message\s*-[_+]\s.*\Z/ms) {
print "Quote follows response, Jeopardy style #3\n";
}
# another way of saying the same
elsif (/^(?:>+\s*)?[_-]+\s*Reply Separator\s*[_-]+\s.*\Z/ms) {
print "Quote follows response, Jeopardy style #4\n";
}
}
sub overquoted {
# cfoq: check fascistly overquoted by tchrist@mox.perl.com
# (wants perl 5.0 or better; developed under 5.002)
my (
$total, # total number of lines, minus sig and attribution
$quoted_lines, # how many lines were quoted
$percent, # what percentage this in
$pcount, # how many in this paragraph were counted
$match_part, # holding space for current match
$gotsig, # is this the sig paragraph?
);
$total = $quoted_lines = $pcount = $percent = 0;
my $MINLINES = 20;
my $TOLERANCE = 50;
my $VERBOSE = 0;
if (body() =~ /^-+\s*Original Message\s*-+$/m) {
my $body = strip_signature(body());
my($text,$quote) = body() =~ /(.*)(^-+\s*Original Message\s*-+.*\Z)/ms;
$total = ((my $x = body()) =~ y/\n//);
$quoted_lines = ($quote =~ y/\n//);
}
else {
for (paragraphs()) {
# strip sig line, remember we found it
$gotsig = s/^-- \n.*//ms;
# strip attribution, possibly multiline
if ($. == 2) { s/\A.*?(<.*?>|\@).*?:\n//s }
# toss trailing blank lines into one single line
s/\n+\Z/\n/;
# now reduce miswrapped lines from idiotic broken PC newsreaders
# into what they should have been
s/(>.*)\n\s*([a-zA-Z])/$1 $2/g;
# count lines in this paragraph
$total++ while /^./mg;
# is it a single line, quoted in the customary fashion?
if ( /^(>+).*\n\Z/ ) {
$quoted_lines++;
print " 1 line quoted with $1\n" if $VERBOSE;
next;
}
# otherwise, it's a multiline block, which may be quoted
# with any leading repeated string that's neither alphanumeric
# nor string
while (/^(([^\w\s]+).*\n)(\2.*\n)+/mg) { # YANETUT
$quoted_lines += $pcount = ($match_part = $&) =~ tr/\n//;
printf "%2d lines quoted with $2\n", $pcount if $VERBOSE;
}
last if $gotsig;
}
}
$percent = int($quoted_lines / $total * 100);
if ($total == $quoted_lines) {
print "All $total lines were quoted lines!\n";
# not ok
}
elsif ($percent > $TOLERANCE && $total > $MINLINES) {
print "Overquoted: $quoted_lines lines quoted out of $total: $percent%\n";
}
}
sub unquote_wrap {
my $chunk = shift;
# reduce miswrapped lines from idiotic broken PC newsreaders
# into what they should have been
$chunk =~ s/(>.*)\n\s*([a-zA-Z])/$1 $2/g;
return $chunk;
}
sub good_signature {
my $MAX_SIGLINES = 4;
my $sig = '';
my($is_canon, $separator);
my $body = body();
# sometimes the ms idiotware quotes at the bottom this way
$body =~ s/^-+\s*Original Message\s*-+\s.*\Z//ms;
# first check regular signature
if ($body =~ /\n-- \n(.*)/s) {
$sig = $1;
$is_canon = 1;
}
elsif ($body =~ /\n([_-]{2,}\s*)\n(.*?)$/s) {
$separator = $1;
$sig = $2;
}
for ($separator, $sig) { s/\n\Z// if defined }
my $siglines = $sig =~ tr/\n//;
if ($separator && ($siglines && $siglines < 20)) {
if ($separator eq '--') {
print "Double-dash in signature missing trailing space.\n";
} else {
print "Non-canonical signature separator: `$separator'\n";
}
}
if ($siglines > $MAX_SIGLINES && $siglines < 20) {
printf "Signature too long: %d lines\n", $siglines;
}
}
sub strip_signature {
local $_ = shift;
s/\n-- \n(.*)//s
||
s/\n([_-]{2,}\s*)\n(.*?)$//s;
return $_;
}
sub attribution {
local $_ = body();
s/^\s*\[.*\]\s*//; # remove [courtesy cc]
if (/\A(.*wr(?:ote|ites):?)\n/) {
return $1;
} elsif (/\A(.*?(<.*?>|\@).*?:)\n/s) {
return $1;
} else {
return '';
}
}
sub strip_attribution {
local $_ = shift;
s/^\s*\[.*\]\s*//; # remove [courtesy cc]
# XXX: duplicate code with previous function
s/\A(.*wr(?:ote|ites):?)\n//
||
s/\A(.*?(<.*?>|\@).*?:)\n//s;
return $_;
}
sub annoying_subject {
local $_ = subject();
if ( / ( [?!]{3,} ) /x ||
/ ( HELP ) /x ||
/ ( PLEASE ) /x
)
{
print "Subject line contains annoying `$1' in it.\n";
}
}
sub mimes {
my $mime_crap = 0;
for (content_type()) {
last unless defined;
$mime_crap++;
if (/multipart/i) {
print "Multipart MIME detected.\n";
}
elsif (/html/i) {
print "HTML encrypting detected.\n";
}
elsif (! (/^text$/i || m#^text/plain#i)) {
print "Strange content type detected: $_\n";
}
}
for (content_transfer_encoding()) {
last unless defined;
if (/quoted-printable/i) {
print "Gratuitously quoted-illegible MIMEing detected.\n";
}
}
unless ($mime_crap) {
for (body()) {
if (/\A\s*This message is in MIME format/i) {
print "Gratuitous but unadvertised MIME detected.\n";
}
elsif ( /\A\s*This is a multi-part message in MIME format/i) {
print "Unadvertised multipart MIME detected.\n";
}
}
}
}
sub dns_check {
my $NSLOOKUP = 'nslookup'; # or /usr/ucb?
# first try an MX record, then an A rec (for badly configged hosts)
my $host = shift;
local $/ = undef;
local *NS;
local $_;
# the following is commented out for security reasons:
# if ( `nslookup -query=mx $host` =~ /mail exchanger/
# otherwise there could be naughty bits in $host
# we'll bypass system() and get right at execvp()
my $pid;
if ($pid = open(NS, "-|")) {
$_ = <NS>;
kill 'TERM', $pid if $pid; # just in case
close NS;
return if /mail exchanger/;
# else fall trohugh to next test
} else {
die "cannot fork: $!" unless defined $pid;
open(SE, ">&STDERR");
open(STDERR, ">/dev/null");
{ exec $NSLOOKUP, '-query=mx', $host; } # braces for -w
open(STDERR, ">&SE");
die "can't exec nslookup: $!";
}
if ($pid = open(NS, "-|")) {
$_ = <NS>;
kill 'TERM', $pid if $pid; # just in case
close NS;
unless (/answer:.*Address/s || /Name:.*$host.*Address:/si) {
print "No DNS for \@$host in return address.\n";
}
} else {
die "cannot fork: $!" unless defined $pid;
open(SE, ">&STDERR");
open(STDERR, ">/dev/null");
{ exec $NSLOOKUP, '-query=a', $host; } # braces for -w
open(STDERR, ">&SE");
die "can't exec nslookup: $!";
}
}
sub ck822 {
# ck822 -- check whether address is valid rfc 822 address
# tchrist@perl.com
#
# pattern developed in program by jfriedl;
# see "Mastering Regular Expressions" from ORA for details
# this will error on something like "ftp.perl.com." because
# even though dns wants it, rfc822 hates it. shucks.
my $what = 'address';
my $address = shift;
local $_;
my $is_a_valid_rfc_822_addr;
($is_a_valid_rfc_822_addr = <<'EOSCARY') =~ s/\n//g;
(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n
\015()]|\\[^\x80-\xff])*\))*\))*(?:(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\
xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"
]|\\[^\x80-\xff])*")(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xf
f]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?:[
^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\
xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;
:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*"))
*(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\
n\015()]|\\[^\x80-\xff])*\))*\))*@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\
\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\04
0)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-
\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?
:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80
-\xff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\(
(?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]
\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\
\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*|(?:[^(\040)<>@,;:".\\\[\]\000-\0
37\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:[^\\\x80-\xf
f\n\015"]|\\[^\x80-\xff])*")(?:[^()<>@,;:".\\\[\]\x80-\xff\000-\010\012-\03
7]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\
\[^\x80-\xff])*\))*\)|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*")*<(?:[\04
0\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]
|\\[^\x80-\xff])*\))*\))*(?:@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x
80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@
,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]
)|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^\\
\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff
])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^
\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-
\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-
\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\01
5()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*,(?
:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\0
15()]|\\[^\x80-\xff])*\))*\))*@(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^
\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<
>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xf
f])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^
\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\x
ff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:
[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\00
0-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x8
0-\xff\n\015\[\]]|\\[^\x80-\xff])*\]))*)*:(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*)
?(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000
-\037\x80-\xff])|"(?:[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*")(?:(?:[\040\t]
|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[
^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xf
f]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\
\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"(?:
[^\\\x80-\xff\n\015"]|\\[^\x80-\xff])*"))*(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*@
(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n
\015()]|\\[^\x80-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff
]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\
]]|\\[^\x80-\xff])*\])(?:(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\
xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*\.(?:[\040\t]|\((?
:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80
-\xff])*\))*\))*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@
,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff
])*\]))*(?:[\040\t]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff]|\((?:[^\\\x8
0-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*>)(?:[\040\t]|\((?:[^\\\x80-\xff\n\
015()]|\\[^\x80-\xff]|\((?:[^\\\x80-\xff\n\015()]|\\[^\x80-\xff])*\))*\))*
EOSCARY
if ($address !~ /^${is_a_valid_rfc_822_addr}$/o) {
print "rfc822 failure on $address";
}
}
##############################
package Mail_Message;
use Carp;
use vars qw/$AUTOLOAD/;
# process <ARGV> for a message header and body
# currently this assumes one message per file!
sub main::get_message {
my $msg = bless {}, __PACKAGE__;
local $/ = '';
$msg->{HEADER_STRING} = <>;
chomp $msg->{HEADER_STRING};
for (split /\n(?!\s)/, $msg->{HEADER_STRING}) {
my($tag, $value) = /^([^\s:]+):\s*(.*)\s*\Z/s;
push @{ $msg->{HEADERS}{$tag} }, $value;
$tag =~ tr/-/_/;
$tag = uc($tag);
push @{ $msg->{$tag} }, $value;
}
local $/ = undef;
for ($msg->{BODY} = <>) {
$msg->{PARAGRAPHS} = [ split /\n\n+/ ];
$msg->{LINES} = [ split /\n/ ];
}
return $msg;
}
sub AUTOLOAD {
use vars '$AUTOLOAD';
my $self = shift;
my $field;
($field = uc($AUTOLOAD)) =~ s/.*:://;
my $xfield = "x_" . $field;
if (!exists $self->{$field} && exists $self->{$xfield}) {
$field = $xfield;
}
unless (exists $self->{$field}) {
return undef;
# NOT REACHED
confess "No field $field in message";
}
my $data = $self->{$field};
my @data = ref $data ? @$data : $data;
if (wantarray) {
return @data;
}
else {
return join("\n", @data);
}
}
------------------------------
Date: Thu, 21 Dec 2000 20:20:44 GMT
From: jerome@activeindexing.com (Jerome O'Neil)
Subject: Re: netiquette checking script
Message-Id: <wCt06.2000$eK1.298327@news.uswest.net>
tchrist@perl.com (Tom Christiansen) elucidates:
> We really need shared or cooperative {score,kill}files. I'm thinking
> of some dynamic solution to the noiseboxes, maybe reminiscent of
> Greg Bacon's periodic stats postings. I'll likely start with
> something like this.
>
> --tom
>
> #!/usr/bin/perl -w
> # msgchk - check news message for netiquette issues
Soooo....
Got a little time on your hands, Tom?
I think the 822 regex aught to be in the FAQ.
[ Snip hilarity ]
--
If men could learn from history, what lessons it might teach us! But
passion and party blind our eyes, and the light which experience gives
is a lantern on the stern, which shines only on the waves behind us.
--Samuel Taylor Coleridge, "Recollections"
------------------------------
Date: Thu, 21 Dec 2000 22:25:27 GMT
From: rzilavec@tcn.net (Richard Zilavec)
Subject: Re: netiquette checking script
Message-Id: <3a4280c4.27173000@news.tcn.net>
On 21 Dec 2000 13:13:34 -0700, tchrist@perl.com (Tom Christiansen)
wrote:
>We really need shared or cooperative {score,kill}files. I'm thinking
>of some dynamic solution to the noiseboxes, maybe reminiscent of
>Greg Bacon's periodic stats postings. I'll likely start with
>something like this.
I'm not totally sure what the killfile is, however I'm sure I don't
want to be on it. I'm still very new to posting in newsgroups, I do
my best, take advise from others but I'm still learning and will make
mistakes. I really like this group and hope others like myself are
not penalized for trying.
--
Richard Zilavec
rzilavec@tcn.net
------------------------------
Date: Thu, 21 Dec 2000 19:45:20 GMT
From: dnay@vbs.net
Subject: Perl on Win32 from a unix guy.
Message-Id: <91tmke$lrq$1@nnrp1.deja.com>
Hey All, This is most likely a VERY easy question but it's been giving
me a headache for the last couple of hours. :)
I usually program with perl on unix and enable to get the date I just
call /usr/bin/date with the format that I want and use the results from
STDOUT as my value. The problem is that I am attempting to write a
perlscript on Windows 2000 server now using ActiveState perl and there
obviously is no /usr/bin/date command.
So, what I want to know is what is the best way to get the date/time on
Win32 with ActiveState perl?
Any help would be very much appreciated! Thanks!
Darren Nay - dnay@ibonzai.com
Sent via Deja.com
http://www.deja.com/
------------------------------
Date: Thu, 21 Dec 2000 20:02:34 GMT
From: Dave Brondsema <brondsem@my-deja.com>
Subject: Re: Perl on Win32 from a unix guy.
Message-Id: <91tnkl$mr2$1@nnrp1.deja.com>
In article <91tmke$lrq$1@nnrp1.deja.com>,
dnay@vbs.net wrote:
>
>
> Hey All, This is most likely a VERY easy question but it's been giving
> me a headache for the last couple of hours. :)
>
> I usually program with perl on unix and enable to get the date I just
> call /usr/bin/date with the format that I want and use the results
from
> STDOUT as my value. The problem is that I am attempting to write a
> perlscript on Windows 2000 server now using ActiveState perl and there
> obviously is no /usr/bin/date command.
>
> So, what I want to know is what is the best way to get the date/time
on
> Win32 with ActiveState perl?
Not sure what format you want, but here's something to start with:
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime
(time);
>
> Any help would be very much appreciated! Thanks!
>
> Darren Nay - dnay@ibonzai.com
>
> Sent via Deja.com
> http://www.deja.com/
>
--
Dave Brondsema
Sent via Deja.com
http://www.deja.com/
------------------------------
Date: Thu, 21 Dec 2000 12:09:09 -0800
From: mothra <mothra@nowhereatall.com>
Subject: Re: Perl on Win32 from a unix guy.
Message-Id: <3A426365.10038513@nowhereatall.com>
dnay@vbs.net wrote:
[snipped]
> So, what I want to know is what is the best way to get the date/time on
> Win32 with ActiveState perl?
>
> Any help would be very much appreciated! Thanks!
>
> Darren Nay - dnay@ibonzai.com
>
> Sent via Deja.com
> http://www.deja.com/
Hello,
($day, $mon, $year) = (localtime)[3,4,5];
printf("The date is %04d %02d %02d\n", $year+1900, $mon+1, $day);
------------------------------
Date: Thu, 21 Dec 2000 20:56:09 GMT
From: Darren Dunham <ddunham@redwood.taos.com>
Subject: Re: Perl on Win32 from a unix guy.
Message-Id: <J7u06.358$dU3.52720@news.pacbell.net>
Dave Brondsema <brondsem@my-deja.com> wrote:
> In article <91tmke$lrq$1@nnrp1.deja.com>,
> dnay@vbs.net wrote:
>>
>>
>> Hey All, This is most likely a VERY easy question but it's been giving
>> me a headache for the last couple of hours. :)
>>
>> I usually program with perl on unix and enable to get the date I just
>> call /usr/bin/date with the format that I want and use the results
> from
>> STDOUT as my value. The problem is that I am attempting to write a
>> perlscript on Windows 2000 server now using ActiveState perl and there
>> obviously is no /usr/bin/date command.
>>
>> So, what I want to know is what is the best way to get the date/time
> on
>> Win32 with ActiveState perl?
> Not sure what format you want, but here's something to start with:
> my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime
> (time);
If you just need something as a timestamp (not to parse), then I like
the simplicity of this...
print scalar localtime;
--
Darren Dunham ddunham@taos.com
Unix System Administrator Taos - The SysAdmin Company
Got some Dr Pepper? San Francisco, CA bay area
< Please move on, ...nothing to see here, please disperse >
------------------------------
Date: Thu, 21 Dec 2000 21:19:19 GMT
From: Jeff Helman <jhelman@wsb.com>
Subject: Re: Perl on Win32 from a unix guy.
Message-Id: <3A427436.80D5C5E6@wsb.com>
dnay@vbs.net wrote:
> So, what I want to know is what is the best way to get the date/time on
> Win32 with ActiveState perl?
Take a look at the Date::Format module from CPAN (or download it using
PPM if you are running ActivePerl on the Windows boxes). I'm not really
familiar with the /usr/bin/date command, but this module probably
contains what you want.
Hope this helps,
JH
------------------------------
Date: Thu, 21 Dec 2000 22:43:13 GMT
From: "Robert Basil" <robert@no-spam.basil.com>
Subject: regexp question
Message-Id: <5Iv06.86163$15.18167482@news1.rdc1.az.home.com>
I am trying to start an archive of a mailing list and I need to remove a
part of the message after it is saved to a text file i.e
.....................................................
SUBSCRIBE
If this newsletter has been forwarded to you, and
you wish to subscribe, simply send a blank e-mail to:
mailto:listname@domain.com
UNSUBSCRIBE
You are currently subscribed to mailing-line-name:
myname@domain.com
To unsubscribe send a blank email to
mailto:leave-listname@domain.com
.......................................................
The problem is, the text I want to delete is printed both before and after
the message body text i.e.
.....................................................
SUBSCRIBE
If this newsletter has been forwarded to you, and
you wish to subscribe, simply send a blank e-mail to:
mailto:listname@domain.com
UNSUBSCRIBE
You are currently subscribed to mailing-line-name:
myname@domain.com
To unsubscribe send a blank email to
mailto:leave-listname@domain.com
.......................................................
This is the text part of the email message I want to keep.
.....................................................
SUBSCRIBE
If this newsletter has been forwarded to you, and
you wish to subscribe, simply send a blank e-mail to:
mailto:listname@domain.com
UNSUBSCRIBE
You are currently subscribed to mailing-line-name:
myname@domain.com
To unsubscribe send a blank email to
mailto:leave-listname@domain.com
.......................................................
So when I try and remove them, my regexp also removes the middle part of the
message that I want to keep. I have triend about 20 different regexp's with
no luck so far. Any hints?
Thanks in advance!
Robert Basil
Chandler Unified School District - Chandler, Arizona
------------------------------
Date: Thu, 21 Dec 2000 22:46:55 GMT
From: Jeff Helman <jhelman@wsb.com>
Subject: Re: regexp question
Message-Id: <3A4288B7.14CE8C82@wsb.com>
Robert Basil wrote:
> So when I try and remove them, my regexp also removes the middle part of the
> message that I want to keep. I have triend about 20 different regexp's with
> no luck so far. Any hints?
Why not show us some code? This is a very trivial thing to do, so the
chances are that your code would work with a minor tweak. So post your
latest regex and we'll see what we find.
JH
------------------------------
Date: Thu, 21 Dec 2000 17:34:17 -0500
From: "Some_Indiana_Guy" <!spammed@aye.net!>
Subject: Searching for a Value in an Array to remove
Message-Id: <t451bb7ntlbq8b@corp.supernews.com>
i have an array that looks like this.
@array (".", "..", "filename1", "filename2", "filename3")
i want to search the array for ".." and "." so i can remove them from the
array
no matter where they are in the array. Not just in the beginning of the
array.
and ideas on how this can be done?
------------------------------
Date: Thu, 21 Dec 2000 22:40:27 GMT
From: rzilavec@tcn.net (Richard Zilavec)
Subject: Re: Searching for a Value in an Array to remove
Message-Id: <3a4485b7.28440576@news.tcn.net>
On Thu, 21 Dec 2000 17:34:17 -0500, "Some_Indiana_Guy"
<!spammed@aye.net!> wrote:
>i have an array that looks like this.
>
>@array (".", "..", "filename1", "filename2", "filename3")
This doesn't work...
>
>i want to search the array for ".." and "." so i can remove them from the
>array
Why not just create a tmp array and push in good values into it...
@array = (".", "..", "filename1", "filename2", "filename3");
for(@array) {
unless($_ =~ /\./ || $_ =~ /\.\./) {
push(@tmparray, $_);
}
}
--
Richard Zilavec
rzilavec@tcn.net
------------------------------
Date: Thu, 21 Dec 2000 22:51:01 GMT
From: Jeff Helman <jhelman@wsb.com>
Subject: Re: Searching for a Value in an Array to remove
Message-Id: <3A4289B3.ECA86EB6@wsb.com>
Richard Zilavec wrote:
>
> @array = (".", "..", "filename1", "filename2", "filename3");
> for(@array) {
> unless($_ =~ /\./ || $_ =~ /\.\./) {
> push(@tmparray, $_);
> }
> }
Uhhh, that's probably not going to do what you expect it to. That will
exclude any element that contains a period (and the second expression
will never be tested since a name must contain one period if it contains
two). Also, there's no need to specify $_ as the variable being
examined by the regex, since it is assumed by default.
A better solution would be:
@array = (".", "..", "filename1", "filename2", "filename3");
for (@array) {
push(@TempArray, $_) unless (/^\.{1,2}$/);
}
JH
------------------------------
Date: Thu, 21 Dec 2000 17:57:41 -0500
From: "Some_Indiana_Guy" <!spammed@aye.net!>
Subject: Re: Searching for a Value in an Array to remove
Message-Id: <t452n67pnblkc6@corp.supernews.com>
This is the code (borrowed from someone else) that creates the array.
As you can see it puts a directory listing into the array. I want to
use this array as a list of files to email to an internet email address.
I am not wanting to email the files "." and ".." Is there maybe a way
i can filter this out before it even gets into the array?? That might be
a better way to approach it.
my ($path,@filelist);
$path="/some/unix/path";
opendir(PATH,$path) or die "Can't open dir: $!\n";
@filelist=readdir(PATH);
closedir PATH;
"Richard Zilavec" <rzilavec@tcn.net> wrote in message
news:3a4485b7.28440576@news.tcn.net...
> On Thu, 21 Dec 2000 17:34:17 -0500, "Some_Indiana_Guy"
> <!spammed@aye.net!> wrote:
>
> >i have an array that looks like this.
> >
> >@array (".", "..", "filename1", "filename2", "filename3")
>
> This doesn't work...
>
>
> >
> >i want to search the array for ".." and "." so i can remove them from the
> >array
>
> Why not just create a tmp array and push in good values into it...
>
> @array = (".", "..", "filename1", "filename2", "filename3");
> for(@array) {
> unless($_ =~ /\./ || $_ =~ /\.\./) {
> push(@tmparray, $_);
> }
> }
>
> --
> Richard Zilavec
> rzilavec@tcn.net
------------------------------
Date: Thu, 21 Dec 2000 22:56:15 GMT
From: rzilavec@tcn.net (Richard Zilavec)
Subject: Re: Searching for a Value in an Array to remove
Message-Id: <3a4588b5.29206472@news.tcn.net>
On Thu, 21 Dec 2000 22:51:01 GMT, Jeff Helman <jhelman@wsb.com> wrote:
>
>Uhhh, that's probably not going to do what you expect it to. That will
>exclude any element that contains a period (and the second expression
>will never be tested since a name must contain one period if it contains
>two).
Very true, I only used the data provided and didn't think elements
containing a period.
> push(@TempArray, $_) unless (/^\.{1,2}$/);
I like this...
--
Richard Zilavec
rzilavec@tcn.net
------------------------------
Date: Thu, 21 Dec 2000 22:44:02 GMT
From: bkesuma@yahoo.com
Subject: Sorting hash
Message-Id: <91u13h$v6a$1@nnrp1.deja.com>
Hi there,
I made a script to check how many times a user has posted to mailing
list. The problem is, how can I sort by "how many times they post" not
by name? Here is the code...
#!/usr/bin/perl -w
LOOP: while($line = <>){
if($line =~ /^From:/){
$line =~ s/From: //;
@block = split(" ",$line);
foreach $block (@block){
if($block =~ /@/){
$block =~ /[A-Za-z0-9_.-]*@[A-Za-z0-9_.-]*/;
$block = $&;
$COUNT{$block}++;
next LOOP;
}
}
}
}
foreach $email (sort keys %COUNT){
print "$email = $COUNT{$email}\n";
}
-bk-
Sent via Deja.com
http://www.deja.com/
------------------------------
Date: Thu, 21 Dec 2000 14:26:47 -0600
From: Russ Jones <russ_jones@rac.ray.com>
Subject: Re: very strange thing with closures
Message-Id: <3A426787.DE54BC1F@rac.ray.com>
W K wrote:
>
> >> Ignoring the fact that you sound like a sailor (and that will offend
> >> even some of my ex-navy friends)...
> >
> >Well english is a foreign language to me - or do you talk about
> >that "fucking_"-prefix/postfix ?
>
> Yes, it is far more offensive than many other naughty words.
>
> Perhaps instead of perl golf or modules to write perl in latin, perhaps we
> should have gratuitously bad language perl?
> However, SQL is better in this regard, tempting you from the start in MySQL
> with the good old 'insert into users .....'
For some jobs, you just can't beat COBOL.
001000 PROCEDURE DIVISION.
002000
003000 MAIN-LINE.
003100 GOTO HELL.
004000
005000 HELL.
005100 PERFORM UNNATURAL-ACT UNTIL SATIATED.
006000
007000 UNNATURAL-ACT.
007100 ADD K-Y TO PRIVATE-AREA GIVING BIG-MESS.
That was really hard to type, I kept trying to use ISPF commands!
ps: of course it wouldn't execute, so don't tell me about it.
--
Russ Jones - HP OpenView IT/Operatons support
Raytheon Aircraft Company, Wichita KS
russ_jones@rac.ray.com 316-676-0747
Quae narravi, nullo modo negabo. - Catullus
------------------------------
Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 16 Sep 99)
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: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.
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 V9 Issue 5174
**************************************
