[comp.lang.perl] A ``from'' command?

kayvan@apple.com (Kayvan Sylvan) (03/01/91)

Anyone got a good ``from'' in perl?

			---Kayvan

| Kayvan Sylvan       Unix/C, GNU tools   879 Lewiston Drive   408-978-1407  |
| Sylvan Associates   GUIs, Databases     San Jose, CA 95136  Think Globally |
|                     Networking, X       apple!satyr!kayvan   Act Locally   |
| === Currently looking for contracts === Hire me now! Avoid the rush! ===   |

clipper@no13sun.csd.uwo.ca (Khun Yee Fung) (03/02/91)

In article <1991Mar1.062551.26372@uvaarpa.Virginia.EDU> satyr!satyr!kayvan@apple.com (Kayvan Sylvan) writes:

   Anyone got a good ``from'' in perl?

It depends of course on what you mean by `good'. I remember seeing
quite a few from's in one of the archives for alt.sources. There must
be a flame... er, debate about it before I knew how to read news. 

I use the script below. You can select any header fields you want to
show. The format stements given can be seen as a template.  This
program works under SunOS. It has more than 25 lines, so my
programming style is not good enough yet...

Note: the defined($headers{'Subject'}) kludge must be there otherwise
Perl says 'str_chop internal inconsistency ./from line 50 <MBOX> 193'.
Of course the line numbers depend on where from cannot find the
'Subject:' header. Is there a way to avoid this?

Khun Yee
----

#!/usr2/new/bin/perl                        # -*-perl-*-
# from.
# copyright (c) 1990 Khun Yee Fung
# No warranty. You can do whatever to it except that you cannot sell it
# for profit.
#
eval "exec perl -S $0 $*"
	if $running_under_some_shell;
format new =
[@>>>:@<<<<<<<<<<<<<<<<<<<] ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
    $count, $headers{'From'}, defined($headers{'Subject'}) ? $headers{'Subject'} : ''
.
format save =
[@>>>:@<<<<<<<<<<<<<<<<<<<] @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    $count, $headers{'From'}, $headers{'To'}
    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
    defined($headers{'Subject'}) ? $headers{'Subject'} : ''
.

($user) = getpwuid($<);
$ymbox = "/usr/spool/mail/$user";
$ombox = "$ENV{'HOME'}/vm/inbox";
if (-z $ymbox) {
    print "No New Mail\n";
}
else {
    open(MBOX, "$ymbox");
    print "-- From the system mail box --\n";
    &pbox();
    close(MBOX);
}
if (-z $ombox) {
    print "No Saved Mail\n";
    exit 0;
}
print "-- From the saved mail box --\n";
open(MBOX, $ombox);
$saved = 1;
&pbox();
close(MBOX);

sub pbox {
    local(%headers, $last_field, $body);
    local($count) = 0;
    local($header) = 1;
    while ($_ = <MBOX>) {
	if ($_ =~ /^From[^:]/) {
	    if (defined($headers{'From'}) ||
               ($headers{'From'} = $headers{'From '}) ne '') {
		$~ = ($saved) ? "save" : "new";
		write;
	    }
	    $count = 0;
	    $header = 1;
	    $last_field = '';
	    undef(%headers);
	    ($last_field, $body) = split(/[ :]/, $_);
	    $body =~ s/^[ \t]+//;
	    $headers{'From '} = $body;
	}
	elsif (!$header) {
	    $count++;
	}
	elsif ($_ =~ /^\s$/) {
	    $header = 0;
	}
	elsif ($_ =~ /^[ \t]/) {
	    chop($_);
	    $headers{$last_field} .= $_;
	}
	else {
	    ($last_field, $body) = split(/[ :]/, $_, 2);
	    $body =~ s/^[ \t]+//;
	    $headers{$last_field} = $body;
	}
    }
    if (defined($headers{'From'}) ||
	($headers{'From'} = $headers{'From '}) ne '') {
	$~ = ($saved) ? 'save' : 'new';
	write;
    }
}

__END__
--
----
Khun Yee Fung    clipper@csd.uwo.ca (Internet) 
Alternative: 4054_3267@UWOVAX.BITNET
Department of Computer Science
Middlesex College
The University of Western Ontario
London, Ontario, N6A 5B7  CANADA