perl version of from(1)

[Johan Vromans]

> Anyone know of a cooler way to do this?

Depends on what you call 'cool'	:-) .

#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 05/20/1991 10:09 UTC by jv at pronto
# Source directory /u1/users/jv
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   2214 -rwxr-xr-x from
#
# ============= from ==============
if test -f 'from' -a X"$1" != X"-c"; then
	echo 'x - skipping from (File already exists)'
else
echo 'x - extracting from (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'from' &&
X#!/usr/bin/perl
X
X# This program requires perl version 3.0, patchlevel 4 or higher
X
X# @($)@ from	1.5 - from.pl
X
X# Show messages from a Unix mailbox. With -n: shown message numbers also.
X#
X# Usage "from [-n] MAILBOX..."
X#
X# Don't forget: perl is a Practical Extract and Report Language!
X#
X# Copyright 1989,1990 Johan Vromans <jv at mh.nl>, no rights reserved.
X# Usage and redistribution is free and encouraged.
X
X# Default output format
Xformat =
X@<<<<<<<<<<< "@<<<<<<<<<<<<" ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
X$date,        $from,         $subj
X.
X
X# Output format when sequence numbers are requested
Xformat format_n =
X@>: @<<<<<<<<<<< "@<<<<<<<<<<<<" ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
X$seq, $date,      $from,         $subj
X.
X
X# Parse and stash away -n switch, if provided
Xif ($#ARGV >= 0 && $ARGV[0] eq '-n') {
X  shift (@ARGV);
X  $~ = "format_n";
X}
X
X# Use system mailbox if none was specified on the command line
Xif ( $#ARGV < 0 ) {
X  if ( ! ($user = getlogin)) {
X    @a = getpwuid($<);
X    $user = $a[0];
X  }
X  if ( -r "/usr/mail/$user" ) {		# System V
X    @ARGV = ("/usr/mail/$user");
X  }
X  elsif ( -r "/usr/spool/mail" ) {	# BSD
X    @ARGV = ("/usr/spool/mail/$user");
X  }
X  else {
X    printf STDERR "No mail for $user.\n";
X    exit 1;
X  }
X}
X  
X$seq = 0;
X# Read through input file(s)
Xwhile (<>) {
X
X  # Look for a "From_" header (See RFC822 and associated documents).
X  next unless /^From\s+(\S+)\s+.*(\w{3}\s+\d+\s+\d+:\d+)/;
X
X  chop;
X  $from = $1;  
X  $date = $2;
X  if ( $date eq "" || $from eq "" ) {
X    print STDERR "Possible garbage: $_\n";
X    next;
X  }
X
X  $seq++;
X  # Get user name from uucp path
X  $from = $1 if $from =~ /.*!(.+)/;
X
X  # Now, scan for Subject or empty line
X  $subj = "";
X  while ( <> ) {
X    chop ($_);
X
X    if ( /^$/ || /^From / ) {
X      # force fall-though
X      $subj = "<none>" unless $subj;
X    }
X    else {
X      $subj = $1 if /^Subject\s*:\s*(.*)/i;
X      if ( /^From\s*:\s*/ ) {
X        $_ = $';
X        if ( /\((.+)\)/i ) { $from = $1; } 
X        elsif ( /^\s*(.+)\s*<.+>/i ) { $from = $1; } 
X        elsif ( /^<.+>\s*(.+)/i ) { $from = $1; } 
X      }
X    }
X
X    # do we have enough info?
X    if ( $from && $subj ) {
X      write;
X      last;
X    }
X  }
X}
SHAR_EOF
chmod 0755 from ||
echo 'restore of from failed'
Wc_c="`wc -c < 'from'`"
test 2214 -eq "$Wc_c" ||
	echo 'from: original size 2214, current size' "$Wc_c"
fi
exit 0
-- 
Johan Vromans				       jv at mh.nl via internet backbones
Multihouse Automatisering bv		       uucp: ..!{uunet,hp4nl}!mh.nl!jv
Doesburgweg 7, 2803 PL Gouda, The Netherlands  phone/fax: +31 1820 62911/62500
------------------------ "Arms are made for hugging" -------------------------