Wanting to convert awk to perl

[Robert Earl]

In article <1991May19.064619.2493 at colorado.edu> frechett at spot.Colorado.EDU (-=Runaway Daemon=-) writes:

| So I wrote a script that is in my .forward.  It grabs username from the 
| From: line of incoming mail then prints out 
| MAIL from username    wherever the cursor currently is, and then the cursor
| promptly returns to the M in MAIL.  This of course means that it doesn't 
| mess up my screen at all.  Just recently I mangaged to get the csh script 
| and the awk scripts all into one csh script.  I like it in general, but 
| I feel that it could be done faster in perl.  I can get the various 
| awk routines into perl easily enough but I get stuck trying to emulate 
| other stuff.. I will include my script here and put current comments in 
| double ##.
|
| #!/bin/csh
| # informe      Written by Ian Frechette  frechett at spot.coloraod.edu
|
| # set username to the name of the person who this is to output to...
| set username = frechett
| # find Username's ttys
| set ttys = (`find /dev -user $username -print`)
| ## Figuring out how to do find in perl is puzzling me... and I can't even 
| ## get a system command into a varible that perl can recognize.

You'd use open("find ...|") and read from the pipe filehandle, but
(not surprisingly) it's not necessary in perl.  :-)


| #  Extract address from incoming message. 
| ## first awk routine.. The problems that I had with awk here, was that there is
| ## no way to pass a variable out of awk.. Thus the set address = `` nonsense.
| ## I would like to remedy that.
| set address = `awk '/^From:/ { test = 0 ;for(i = 1 ; i <= NF ; ++ i) { if ($i ~ /@/)  {   if ($i ~ /^</ ) printf ("%s\n", substr($i,2,length($i)-2)); else printf ("%s\n",$i);  test = 1 ; exit } } if (test == 0 ) printf ("%s\n", $2); }'`

What a mess.  Well, my regexp is a mess too, but it's shorter.


| # Echo $address to $username's ttys and then back up to beginning of message
| ## Typically, I put in a couple vt100 escape codes to make "MAIL from" 
| ## display in bold, but I took them out to post.. 

Okay, so you'd want something with octal chars, like "\033[1mMAIL
from\033[0m", if you want to just hardcode it (you could use
termcap... nah :)


| ## This is the second awk routine.. the problem here is that I need to 
| ## get perl to output to however many ttys that it found up above.. twice.

Not necessary.  Just prepare the whole string beforehand.


| echo -n "MAIL from $address" | tee $ttys | \
| awk '{{for (i = 1 ; i <= NF ; ++i) {for (j = 1 ; j <= length($i)-2; ++j)\
| {printf ""} } } ; for (k = 1 ; k <= NF -1 ; ++ k) {printf ""}}' | \
| tee $ttys > /dev/null

Woah.  That's a good one, wait until you see the perl version of it.


| # Make sure no errors are returned or mail will bounce.
| exit(0)

| I would like to know if any perl wizards out there would be interested in 
| giving me some hints on what to do or demonstrating what needs to be 
| changed... Any help at all would be appreciated, and comments regarding the 
| script itself I might find interesting..   Thanks..


Here it is in Perl, maybe someone else will improve on this...

#!/usr/bin/perl
#
# informe -- by Ian Frechette,
#  perl translation by Robert Earl rearl at watnxt3.ucr.edu
#

$username = 'frechett';
# Get numerical userid for the stat()
$uid = (getpwnam($username))[2];

# this warn should be die, but this is in a .forward, so...
opendir(DEV, "/dev") || warn "opendir failed: $!\n";

# slurp in all the entries in /dev and return those that match our uid
@ttys = grep((stat("/dev/$_"))[4] == $uid, (readdir(DEV)));
closedir(DEV);

while (<>) {
    # get rid of newline
    chop;
    # look for "From:" followed by zero or more spaces, followed by either:
    # 1: <foo at bar> with <> brackets being optional, or
    # 2: the first field not containing a space.
    s/^From: *(<?([^>]*@[^>]*)>?|([^ ]+))/$address = ($2 || $3)/e;
}

$msg = "MAIL from $address";

# easy, eh?
$msg .= "\b" x length $msg;

# A loop instead of using 'tee'
for $tty (@ttys) {
    open(TTY, ">/dev/$tty") || warn "Can't open $tty: $!\n";
    print TTY $msg;
    close TTY;
}

exit 0;


--
______________________________________________________________________
			\					
 robert earl		/	"Love is a many splintered thing"
 rearl at watnxt3.ucr.edu	\		--Sisters of Mercy
 rearl at gnu.ai.mit.edu	/