HDTenEightyP/NetNews huggingface dataset:
From: jns@ace.nas.nasa.gov (John N. Stewart)
Newsgroups: comp.lang.perl
Subject: Re: Problems with "tee"
Date: 21 Aug 92 20:27:26 GMT
Distribution: usa
Organization: NAS, NASA Ames Research Center, Moffett Field, CA

In article <1992Aug21.172813.13174@odin.corp.sgi.com> rodman@pkr.asd.sgi.com (Paul Rodman) writes:
>
>I'm having a problem with the following use of "/bin/tee" within 
>a open statement. 
>
>This is the sampleprogram:
>---------------------------------------------------------
>#!/usr/local/bin/perl
>
>open (FOO, "| tee >foobaz");
>print FOO "This is a test of tee with perl\n";
>close FOO;
>
>exit;
>---------------------------------------------------------


The ">" is redirecting STDOUT into the file.

--
John Stewart (Ace)
CSS/DSS
NASA Ames Research Center
(415) 604-4345
From: joel@abigale.uucp (Joel Rosi-Schwartz)
Newsgroups: comp.lang.perl
Subject: Re: Applauds for Mr. Wall (LOUD)
Date: 18 Aug 92 19:55:52 GMT
Organization: Techne Research, Finchampstead, Berkshire (UK)

In article <MERLYN.92Aug18072820@romulus.reed.edu> merlyn@romulus.reed.edu (Randal L. Schwartz) writes:
>In article <1992Aug.004245.29615@abigale.uucp> joel@abigale.UUCP (Joel Rosi-Schwartz) writes:
>   I for one, want to applaud Larry for the "kind, faceless, gentle,
>   unassuming, *non-obnoxious* and generally friendly way he supports us.
>
>Some people assume that Larry and I are "old buddies" going "way back"
>just because he and I share the by-line on the Camel Book.  We're not.
>
  [lots deleted, but please back up and read it ;-]

That was a really neat and personal sharing.  Thank you for taking the
time to put it down.  Maybe it should go in the intro to the new book ;-)

>Larry is a true giver.  He works hard at all hours of the night so
>that *we* can work a little easier. He's that way with his family, and
>with his friends, and with the thousands of people that have used rn,
>patch, and Perl.

Yup, this is exactly how I get him, even though I have never had the
pleasure to meet him---someday I would hope to.

And by the way, I singled Larry out because it was what hit me at the
moment I was reading his response, but that in no way deminishes my
respect and gratitude for you (Randal) and Tom C.  But what is really
neat about Perl and this group, is that just about *everyone* who
participates seems to really care about it working.  That feels
real good ;-)

>
>Thanks, Larry.
>
>print "Just another Perl hacker," if "not also a big Larry fan"
>--
>Randal L. Schwartz / Stonehenge Consulting Services (503)777-0095
>merlyn@reed.edu (guest account) merlyn@ora.com (better for permanent record)
>cute quote: "Welcome to Portland, Oregon -- home of the California Raisins!"

Cheers,
Joel

-- 
     ==================================================================
     ||               T E C H N E   R E S E A R C H                  ||
     ||  ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++  ||
     ||                     Joel Rosi-Schwartz                       ||
     ||   Hildorien House            +   Email: joel@abigale.UUCP    ||
     ||   12 Waverley Way            +    (pyrltd!abigale.UUCP!joel) ||
     ||   Finchampstead, Wokingham   +   Phone: +44 (734) 730.260    ||
     ||   Berkshire RG11 4YD (UK)    +   Fax:   +44 (734) 730.272    ||
     ==================================================================
From: ej@id.dth.dk (Erik Johansen)
Newsgroups: comp.lang.perl
Subject: How do I determine if variable is tainted
Keywords: perl taint
Date: 13 Aug 92 09:10:38 GMT
Organization: Department of Computer Science


I have been puzzled for some time because of a script
that stops because of an unsecure dependency in an eval.

What I really want is if anyone has a routine for listing
all the variables that are tainted.


- Erik

---
 $txt=" ltrterhnuc--sor eep-\nkJ.a "; srand(53747414);
 for (1..26) { print substr($txt,rand 27,1); }  ### Is this a random write ?
-- 
---
Erik Johansen                  E-mail: ej@id.dth.dk
Institute for Computer Science, Copenhagen, Denmark
From: rodman@pkr.asd.sgi.com (Paul Rodman)
Newsgroups: comp.lang.perl
Subject: Re: Problems with "tee"
Date: 21 Aug 92 21:59:40 GMT
Reply-To: rodman@pkr.asd.sgi.com (Paul Rodman)
Distribution: usa
Organization: Silicon Graphics Inc.

In article <1992Aug21.202726.15093@nas.nasa.gov>, jns@ace.nas.nasa.gov (John N. Stewart) writes:
|> In article <1992Aug21.172813.13174@odin.corp.sgi.com> rodman@pkr.asd.sgi.com (Paul Rodman) writes:
|> >
|> >I'm having a problem with the following use of "/bin/tee" within 
|> >a open statement. 
|> >open (FOO, "| tee >foobaz");
|> 
|> The ">" is redirecting STDOUT into the file.
|> 
|> --
|> John Stewart (Ace)

Duh. Argh.
Thanks to all those that pointed out the problem with my memory, rather than 
"tee" or "open". sigh.

-paul
Newsgroups: comp.lang.perl
From: mcook@fendahl.dev.cdx.mot.com (Michael Cook)
Subject: Re: Help with named pipes
Organization: Motorola Codex, Canton, Massachusetts
Date: Wed, 12 Aug 1992 22:09:39 GMT

cole@concert.net (Derrick C. Cole) writes:

>if (-p $pipe) {
>   open(FIFO, "$pipe") || die "can't open\n";
>   while (<FIFO>) {
>      read(FIFO, $buf, 120);
>      chop($buf);
>      print "|$buf|\n";
>   }
>}

The <FIFO> expression is going to read a newline-terminated line from <FIFO>.
That's probably not what you want...

>Now, 120 is an arbitrary number out of the air.  What I'd really like is for
>read() to place in $buf a null-terminated string as written by the other end,
>and not just 120 characters.  Am I completely blind, is there a way to do
>this, neither, or both?

How about this:

  $/ = "\000";		# the input record separator
  while (<FIFO>)
  {
    chop;		# discard the \0
    print "|$_|\n";
  }

Michael.
From: andy@orchid.bdc.ubc.ca (Andrew Dwelly)
Newsgroups: comp.lang.perl
Subject: Arrays of filehandles
Date: 12 Aug 92 23:04:11 GMT
Organization: University of British Columbia, Vancouver, B.C., Canada


I am writing a script which works on a number of files (1 .. n) which
must all be opened at the same time for reading. I'd like to write
something like

# This bit does work,

foreach $i (0 .. $#ARGV)
{
    open(@filehandle[$i],"<".@ARGV[$i]) || die "Can't open @ARGV[$i]\n";
}

# But this bit just falls through as if @filehandle[0] was empty
while (<@filehandle[0]>)
{
....etc etc

I need to get various lumps of data from <@filehandle[$whatever]> in the
rest of the code. 

As you might guess, this doesn't work in the above form. I've looked
at the camel book and the man page, and I realize I've bumped into
the idirect filehandle issue, but - sorry Larry - I didn't understand
the explanation as you can see.

What should I be doing here. Also, what is the difference between an
array @this[$that] and $this[that] ? this has also been troubling
me in the last few days.

All advice gratefully received.

Andy Dwelly (andy@bcu.ubc.ca)
From: fabbott@athena.mit.edu (Freeland K Abbott III)
Newsgroups: comp.lang.perl
Subject: VMS port of perl?
Date: 19 Aug 92 00:21:54 GMT
Distribution: comp
Organization: Massachusetts Institute of Technology

Has anyone done a port for VAX/VMS?  A friend at work was hoping to
save himself the effort....

--
Freeland K. Abbott              fabbott@athena.mit.edu
104 Madison Ave.                now working for Cambridge Technology Group
Arlington, MA 02174             "And I thought 14-hr days would be over now"
Newsgroups: comp.lang.perl
From: jhd@irfu.se (Jan D.)
Subject: Re: Assoc array indirection
Date: Mon, 17 Aug 1992 15:45:18 GMT
Organization: Swedish Institute of Space Physics, Uppsala, Sweden

In article <1992Aug17.100513.9649@nuscc.nus.sg> ccechk@nuscc.nus.sg (Heng Kek) writes:
>Greetings
>
>#!/usr/bin/perl
>  %ipaddr = ('nusunix1','137.132.73.11',
>             'nusunix2','137.132.10.11',
>             'nusunix3','137.132.91.12'
>            );
>  @host   = ('nusunix1',
>             'nusunix2',
>             'nusunix3'
>            );
>print eval "\@ipaddr{@host[0..1]}";              # no go
>print eval "\@ipaddr{join(',', @host[0..1])}";  # no go
>print eval "\@ipaddr{$host[0], $host[1]}";      # okay
>
>Why doesn't the 1st 2 print()s do what I expect?  How do I achieve
>my goal, given my intentions in:
>
>print eval "\@ipaddr{join(',', @host[0..1])}";  # no go
>?
>
>Or is it just wishful thinking?
>Hope someone can help.  Thanks

I'm not sure I understand your goal, but if it is comma separated
ip numbers you wan't, this works:

print join(',', @ipaddr{@host[0..1]});

You can get the first print to work by simply removing the eval:

print @ipaddr{@host[0..1]};

>
>Heng Kek

	Jan D.
From: bush@ecs.ox.ac.uk (Mark Bush)
Newsgroups: comp.lang.perl
Subject: Re: How to wait for a pipe to complete a task?
Date: 14 Aug 92 16:41:26 GMT
Organization: Oxford University Computing Laboratory

In article <1992Aug14.145310.29093@raid.dell.com> painter@manufing.dell.com (Tom Painter) writes:
#I need to write a program with batch FTP.  I keep hitting the following

There are probably a number of ways of doing what you want, however the
following script which uses chat2 is what I use for doing backgrounded FTP
jobs at suitable hours.  I have a version of chat2 which I call chat2verbose
which is obtained using the following patch:

*** /usr/local/lib/perl/chat2.pl        Mon Dec  9 16:32:01 1991
--- /usr/local/lib/perl/chat2verbose.pl Fri Dec 13 18:52:49 1991
***************
*** 221,226 ****
--- 221,227 ----
                                $nread = sysread(S, $thisbuf, 1024);
                                if ($nread > 0) {
                                        $S .= $thisbuf;
+                                       printf STDERR "%s", $thisbuf;
                                } else {
                                        $eof++, redo LOOP; # any error is also eof
                                }

which just helps to produce a record on STDERR of the entire session.

Anyway, the important part about the script is that it doesn't send the next
command until it gets the ftp prompt back, so after a put, it will be safe
to delete the file (assuming it transfered ok, but that's another story! 8*).

An example script would be:
---------------
open src.doc.ic.ac.uk
cd gnu
bin
get perl-4.035.tar.Z
quit
---------------

Update $name and $password accordingly, though it is unwise to do this for
non-anonymous ftp!...

Changing the script for your purposes should be fairly straight-forward.

Mark

#!/usr/local/bin/perl

require 'chat2verbose.pl';

$SCRIPT = shift || "ftp.script";
open(SCRIPT) || die "Can't open $SCRIPT: $!\n";
@messages = <SCRIPT>;
close(SCRIPT);

$handle = &chat'open_proc("/usr/ucb/ftp");

$count = 0;
$name = "anonymous\n";
$password = "bush@comlab.ox.ac.uk\n";    # My e-mail address

while (1)
{
    &chat'expect($handle, 2,
	'EOF', '&chat\'close($handle); exit;',
	'^Name.*$', '&chat\'print($handle, $name)',
	'^ftp\n', '',
	'^Password.*$', '&chat\'print($handle, $password)',
	'^\n', '',
	'^ftp> $', '&sendinfo',
	'^.+\n', '',
	'^.+$', ''
	);
}

sub sendinfo
{
    &chat'print($handle, $messages[$count++]);
}
Newsgroups: comp.lang.perl
From: lea%anl433.uucp@Germany.EU.net (Iain Lea)
Subject: Re: locsym - First major upgrade ;-)
Reply-To: iain%anl433.uucp@Germany.EU.net
Organization: ANL A433, Siemens AG., Germany.
X-Newsreader: Tin 1.1 Beta PL6
Date: Fri, 21 Aug 1992 08:51:13 GMT

Joel Rosi-Schwartz (joel@abigale.UUCP) wrote:
: 
: Oh, I guess I am spoiled. ISC and SCO come with a program called "cscope"
: which does just this and more.  If there was enough demand from folks who
: do not have "cscope" I would be willling to expand locsym to handle it.
: Let me know.

I know about cscope. Quite a neat tool. Unfortunately cscope has problems:
1. Its only available under SysV
2. Sourcfe code is not generally available (ie. source licence required)

Iain

--
NAME   Iain Lea 
EMAIL  iain%anl433.uucp@Germany.EU.net
SNAIL  Siemens AG, ANL A433SZ, Gruendlacher Str. 248, 8510 Fuerth, Germany.
PHONE  +49-911-3089-407 (work) +49-911-331963 (home) +49-911-3089-290 (FAX)
From: stantz@sgi.com (Mark Stantz)
Newsgroups: comp.lang.perl
Subject: Re: Avoiding intermediate variable
Date: 21 Aug 92 00:33:14 GMT
Organization: Silicon Graphics, Inc.

In article <MARK.MCINTOSH.92Aug20145545@sombrio.UVic.CA> Mark.McIntosh@engr.UVic.CA (Mark  McIntosh) writes:
>Someone out my location would like to avoid the intermediate variable
>in the following piece of code, assuming $y has been set to some value:
>
>       $tmp = $y;
>       $tmp =~ s/xy/zz/;
>       print $tmp;
>
>He wants to retain the value of $y for later use but use a modified
>version of it once - he won't need it later.  Is there a way to do
>this in Perl without using an intermediate variable?

	Don't know whether or not it can be done without a temporary 
variable or not, but

		print ((($junk = $y) =~ s/xy/zz/) ? $junk : $y);

	should do the job.  You need those outermost parentheses, BTW.

	Of course, if you're sure the substitution will succeed, you can
get away with:

		print $junk if (($junk = $y) =~ s/xy/zz/);

	which is marginally easier to read.  

	-mfs
From: eric.arnold@Sun.COM (Eric arnold)
Newsgroups: comp.lang.perl
Subject: Re: Arrays of filehandles
Date: 14 Aug 92 19:26:36 GMT
Article-I.D.: jethro.l8o27cINNocq
Reply-To: eric.arnold@Sun.COM
Distribution: world
Organization: Sun Microsystems, Inc.
NNTP-Posting-Host: animus.corp.sun.com

In article 10760@unixg.ubc.ca, andy@orchid.bdc.ubc.ca (Andrew Dwelly) writes:
>In article <1992Aug13.145758.14449@news.uit.no> tomg@stud.cs.uit.no (Tom  
>Grydeland) writes:
>
>
>#!/local/bin/perl
>
>open($a[0],"<one");
>while (<$a[0]>)
>{
>    print;
>}
>
>Which fails to work.
>whereas, in perl 4.035 under SunOS 4.1.2, the best I've been able to
>come up with is ....
>#!/local/bin/perl
>
>open(scalar($a[0]),"<one");
>$foobar = $a[0];
>while (<$foobar>)
>{
>    print;
>}
>

This works, without using "scalar" (I added assignment to "@a" because
it made me feel better, though I assume the above script also implies 
setting "@a"):
	
	$fh_gen = "FH000";
	for ( 1..25 ){ push( @a, $fh_gen++ ) ; }
	open($a[0],"<one");
	$foobar = $a[0];
	while (<$foobar>)
	{
	    print;
	}

but I am also puzzled about why this doesn't work:

	$fh_gen = "FH000";
	for ( 1..25 ){ push( @a, $fh_gen++ ) ; }
	open($a[0],"<one");
	while (<$a[0]>)
	{
	    print;
	}



>That is, not only must the array be made explicitly scalar during the  
>assignment of the file handle, but also it must be assigned to
>an ordinary scalar before use in angle brackets (I suspect this is because 
>perl defines <scalar($a[0])> as a syntactic no-no).

"scalar($a[0])" should be the same as "$a[0]", no?  Isn't "$a[0]" already
a scalar?  It would seem that the thing that is operating here is only
that "<$foobar>" works, and "<$a[0]>" doesn't, meaning that you can't
use an array element inside "<>".

>
>The second version works, but is rather inelegant. Is there any way it can  
>be improved to remove the superfluous $foobar ?
>
>Andy Dwelly (andy@bcu.ubc.ca)


This doesn't work either:

 
	$a{ "first" } = "FH";
	open($a{first},"<one");
	while (<$a{first}>)
	{
	  print;
	}

though if you add the intervening "$foobar", it does work.

-Eric

P.S. I tried this under perl4.019, SunOS4.1.1.
Newsgroups: comp.lang.perl
From: brister@decwrl.dec.com (James Brister)
Subject: Re: Applauds for Mr. Wall (LOUD)
Organization: DEC Western Software Lab
Date: 18 Aug 92 18:38:14

On Tue, 18 Aug 1992 23:53:25 GMT, vspicer@ccu.umanitoba.ca said:

> one can't say enough. i haven't had this much fun programming computers since
> high school using Zbasic on a TRS-80 Model 4. thanks larry!  

Ohhhh. I'm not sure I'd take that as a complement :-)

James
--
James Brister                                           brister@wsl.pa.dec.com
DEC Western Software Lab., Palo Alto, CA                        decwrl!brister
Newsgroups: comp.lang.perl
From: robt@is.morgan.com (Rob Torop)
Subject: usersub
Organization: Morgan Stanley & Company
Distribution: comp.lang.perl
Date: Wed, 12 Aug 1992 16:36:21 GMT

I've been fooling around a lot with usersub.  I've managed to hook
some things in, but I think I've got a memory leak.  I ran a perl
program to check for leaks by calling my usersub in an infinite loop.
It ran out of memory after around 180,000 calls.  Here's my code - if
there's something obviously wrong, I'd really appreciate some advice!

p.s.  do_tval does *no* memory allocation at all.

case US_tv:
    if (items < 7)
      fatal("Usage &tv($descr,$ul,$strike,$tex,$vola,$rfr,$divyld [,$hints])");
    else {
        char *   descr  = (char *) str_get(st[1]);
        double   ul     = (double) str_gnum(st[2]);
        double   strike = (double) str_gnum(st[3]);
        double   tex    = (double) str_gnum(st[4]);
        double   vola   = (double) str_gnum(st[5]);
        double   rfr    = (double) str_gnum(st[6]);
        double   divyld = (double) str_gnum(st[7]);
        TvHints  hints  = 0;
        TvTheoValue tv;

        if (items > 7) 
            hints = (TvHints) str_gnum(st[8]);
            
        if (!do_tval(descr,ul,strike,tex,vola,rfr,divyld, hints, &tv))
            fatal("tv: Valuation error");

        astore(stack, sp+7, NULL);
        st[0] = str_2mortal(str_nmake(tv.thVal[0]));
        st[1] = str_2mortal(str_nmake(tv.delta[0]));
        st[2] = str_2mortal(str_nmake(tv.gamma[0]));
        st[3] = str_2mortal(str_nmake(tv.theta[0]));
        st[4] = str_2mortal(str_nmake(tv.kappa[0]));
        st[5] = str_2mortal(str_nmake(tv.rho[0]));
#ifdef RHODIV
        st[6] = str_2mortal(str_nmake(tv.rhodiv[0]));
#else
        st[6] = str_2mortal(str_nmake(0.0));
#endif
        return sp + 7 - 1;
    }
--
-- Rob Torop

+---------------------------------------------------------------------+
| The views expressed here are neither mine nor those of my employer. |
+---------------------------------------------------------------------+
Newsgroups: comp.lang.perl
From: lea%anl433.uucp@Germany.EU.net (Iain Lea)
Subject: Re: locsym - First major upgrade ;-)
Reply-To: iain%anl433.uucp@Germany.EU.net
Organization: ANL A433, Siemens AG., Germany.
X-Newsreader: Tin 1.1 Beta PL6
Date: Wed, 19 Aug 1992 13:05:25 GMT

Thanx for a useful package that has been put to good use here.

What would be just as useful would be quick access to header files.

The following info would be useful:
  #defines
  struct's
  variables

Are you planning to expand locsym to handle such things?

Iain

PS. I know about [ce]tags etc.

--
NAME   Iain Lea 
EMAIL  iain%anl433.uucp@Germany.EU.net
SNAIL  Siemens AG, ANL A433SZ, Gruendlacher Str. 248, 8510 Fuerth, Germany.
PHONE  +49-911-3089-407 (work) +49-911-331963 (home) +49-911-3089-290 (FAX)  
Newsgroups: comp.lang.perl
From: mcook@melkur.dev.cdx.mot.com (Michael Cook)
Subject: Re: handling symbolic links
Organization: Motorola Codex, Canton, Massachusetts
Date: Fri, 21 Aug 1992 22:34:07 GMT

przemek@rrdstrad.nist.gov (Przemek Klosowski) writes:

> A baroque solution to a simple problem? maybe;

You know what they say... if it isn't baroque, don't fix it! :-)
Newsgroups: comp.lang.perl
From: daleske@cbnews.cb.att.com (John D. Daleske)
Subject: Filename expansion ("~user")
Organization: Stratus Computers, Inc.
Distribution: usa
Date: Thu, 20 Aug 1992 15:37:27 GMT
Keywords: ~user filename expansion

I'm relatively new to Perl and love it.  I've read the recent notes in this
notes group and have not found how do one capability that I am trying to
use in a Perl script which is the ~user filename expansion.  Following is a test
script:

$tst1="~daleske";
die "${tst1} not a directory" if !(-d ${tst1});
opendir(DH, ${tst1});
@allfiles = readdir(DH);
closedir(DH);
print "@allfiles\n";

If I set $tst1 to the full pathname it works fine.  I'd like to use the common
facility of ~user to avoid needing to know the full path name.  (User home
directories do get moved around.)

Suggestions are appreciated!
John
From: steed@ilws14 (Ze'ev Shtadler)
Newsgroups: comp.lang.perl
Subject: open(lockfile, O_CREAT|O_WRONLY|O_EXCL, 0444) in perl?
Keywords: lock file
Date: 19 Aug 92 08:22:44 GMT
Organization: Intel
X-Newsreader: Tin 1.1 PL4

I'd like to have a perl script that uses a lock file as a semaphore
across NFS of diverse hardware platforms and operating systems.  I was
told, this is the only "real safe" way to ensure exclusive access
between processes on different machines (I know this does not apply to
processes not bothering to lock :-).  Can that be done from within
perl?

Ze'ev.

--
Ze'ev "Steed" Shtadler, Design Technology, IDC2-41,
INTeL Israel, P.O. Box 1659, Haifa 31015, ISRAEL.
steed@iil.intel.com	Work: +972-4-355935	FAX: +972-4-355666
iNET: 8-435-5935	Home: +972-4-220306
Newsgroups: comp.lang.perl
From: "G.W.Bultman" <bultman@dgw.rws.nl>
Subject: Please send dutree
Reply-To: bultman@dgw.rws.nl
Organization: The Internet
Date: Fri, 14 Aug 1992 06:41:01 GMT

Hi, 

There has been quite some traffic on this list about a utility 'dutree'.
Could someone please send it to me? 
My unix box is a HP9000/870 running HP-UX.
Thanks
Gert.
--

    o                                                                o   
  / | \    Gert Bultman <bultman@dgw.rws.nl>   Koningskade 4       / | \  
 o--o--o   Tidal Waters Division               2596 AA The Hague  o--o--o 
  \ | /    Rijkswaterstaat                     The Netherlands     \ | /  
    o                                                                o    

Newsgroups: comp.lang.perl
From: rwk@crl.dec.com (Bob Kerns)
Subject: Re: Sendmail and perl
Organization: Cambridge Research Lab, Digital Equipment Corp.
Date: Tue, 18 Aug 1992 08:04:32 GMT

In article <1992Aug5.151424.6313@eagle.lerc.nasa.gov> drich@sandman.lerc.nasa.gov (Daniel Rich) writes:

   From: drich@sandman.lerc.nasa.gov (Daniel Rich)
   Date: Wed, 5 Aug 1992 15:14:24 GMT

   I am in need of a perl script that will talk to sendmail (allow me to
   send commands to the sendmail port on a specified machine, and process
   the output).  While I could write this myself, I assume that this is
   something that people have done before.  What is available out there?

Here's one I find very useful:  It expands mailing lists.  I use this
to help figure out what the right place to send to is.

----------------------------------------------------------------
#!/usr/local/bin/perl

require 'chat2.pl';

select((select(STDOUT),$|=1)[0]);

(@ARGV[0] eq '-recursive') && ($recursive = shift(@ARGV));

(@ARGV >= 2) || die("Usage: $0 [-recursive] host address ...\n");

&expn(@ARGV);

%BUCKETS=();

sub address
{   local($old_host,$old_user,$address) = @_;
    local($user, $host) = ($address =~/<(.+)@(.+)>/);
    $host=~tr/a-z/A-Z/;
    print "    $address\n";
    if ($host=~/^[^.]+$/) {
	$host .= "." . $old_host;
    }
    if ($host && (($host ne $old_host) || ($user ne $old_user))) {
	if (!($user=~/^".*"$/)) {
	    local($bucket) = $BUCKETS{$host};
	    $BUCKETS{$host} = ($bucket ? ($bucket . "\n" .  $user) : $user);
	}
    }
}

sub expn
{   local($host,@addresses) = @_;
    local($addresses);
    $host=~tr/a-z/A-Z/;
    while (@addresses) {
	print("Expanding users on $host.\n");
	if (!&chat'open_port($host,25) # '
	    ) {
	    print("Could not connect to $host\n");
	} else {
	    1  while &chat'expect(20,
	         '^(220-.*)\r?\n\r?','1',
	         '^(220 .*)\r?\n\r?','0',
	         '^(.*)\n\r?','warn("No header: $1\n");0'
		   );		# '
	    for $user (@addresses) {
		print("  $user:\n");
		&chat'print("expn $user\r\n"); # '
		while (&chat'expect(40,
                    '^250-(.*[^\r])\r?\n\r?',"&address('$host','$user',\$1); 1",
                    '^250 (.*[^\r])\r?\n\r?',"&address('$host','$user',\$1); 0",
                    '^550(.*)\n\r?', q!print "no such user as $user: $1\n"; 0!,
                    '^5\d\d(.*)\n\r?', q!print "Error: $1\n"; 0!,
                    TIMEOUT,'print("$host: timeout\n"); 0',
                    '(.*)\n','print "Unknown response: $1\n";0'
	             )		# '
		       ) {1;}
	    }
	    &chat'close();	# '
	}
	shift(@addresses);
	if ($recursive) {
	    ($host,$addresses)=(%BUCKETS)[0,1];
	    delete $BUCKETS{$host};
	    push(@addresses,split("\n",$addresses));
	} else {
	    next;
	}
    }
}
Newsgroups: comp.lang.perl