perl version of from(1)

[Martin Boyer]

jv at mh.nl (Johan Vromans) writes:

   > From: subbarao at phoenix.Princeton.EDU (Kartik Subbarao)
   > Subject: perl version of from(1)
   > Date: 19 May 91 23:54:24 GMT
   > Organization: American Chemical Society

   > Anyone know of a cooler way to do this?

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

   [shar of from.pl 1.5 deleted]

Here's my version modified to:

    handle multiple mailboxes (default is $HOME/INBOX, created by vm)
    reset message counter for each mailbox
    test for presence of mailbox instead of spool directory in BSD systems


#!/usr/bin/perl
#----Le laboratoire de robotique de l'Institut de recherche d'Hydro-Quebec-----
# 
# Nom     : from [-n] [MAILBOX] [MAILBOX...]
# Fonction: Imprime un sommaire de la boite postale,
#	    avec -n, imprime les numeros de message aussi.
# Fichiers: from, /usr/spool/mail, ~/INBOX
# Notes   : Requiert perl version 3.0, patchlevel 4 ou mieux.
# 
# Cree    :    1989  ------------ Johan Vromans <jv at mh.nl>
# Modifie : 21 mai 91 ---------1- Martin Boyer <mboyer at ireq-robot.hydro.qc.ca>
#	    Copyright 1989, 1990 Johan Vromans <jv at mh.nl>, no rights reserved.
# 
# Historique: 
# 
# 21 mai 91 ---------1- Martin Boyer <mboyer at ireq-robot.hydro.qc.ca>
# 	Modifie la version 1.5 de Johan Vromans: ajoute INBOX
# 	et remis le compteur de message a zero pour chaque fichier.
#------------------------------------------------------------------------------

$inbox = "$ENV{'HOME'}/INBOX";

# Default output format
format =
@<<<<<<<<<<< "@<<<<<<<<<<<<" ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
$date,        $from,         $subj
.

# Output format when sequence numbers are requested
format format_n =
@>: @<<<<<<<<<<< "@<<<<<<<<<<<<" ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<..
$seq, $date,      $from,         $subj
.

# Parse and stash away -n switch, if provided
if ($#ARGV >= 0 && $ARGV[0] eq '-n') {
  shift (@ARGV);
  $~ = "format_n";
}

# Use system mailbox and user INBOX 
# if none was specified on the command line
if ( $#ARGV < 0 ) {
    if ( ! ($user = getlogin)) {
	@a = getpwuid($<);
	$user = $a[0];
    }
    if ( -r "/usr/mail/$user" ) {	    # System V
	@ARGV = ("/usr/mail/$user");
    }
    elsif ( -r "/usr/spool/mail/$user" ) {  # BSD
	@ARGV = ("/usr/spool/mail/$user");
    }
    if ( $inbox && -r $inbox ) {
	@ARGV = ($inbox, @ARGV);
    }
    if ($#ARGV < 0)  {
	printf STDERR "No mail for $user.\n";
	exit 1;
    }
}
if ( $#ARGV < 0 ) {
  if ( ! ($user = getlogin)) {
    @a = getpwuid($<);
    $user = $a[0];
  }
  if ( -r "/usr/mail/$user" ) {		
    @ARGV = ("/usr/mail/$user");
  }
  elsif ( -r "/usr/spool/mail/$user" ) {	# BSD
    @ARGV = ("/usr/spool/mail/$user");
  }
  else {
    printf STDERR "No mail for $user.\n";
    exit 1;
  }
}
  
# Read through input file(s)
while (<>) {

  if (eof) {$seq = 0;}

  # Look for a "From_" header (See RFC822 and associated documents).
  next unless /^From\s+(\S+)\s+.*(\w{3}\s+\d+\s+\d+:\d+)/;

  chop;
  $from = $1;  
  $date = $2;
  if ( $date eq "" || $from eq "" ) {
    print STDERR "Possible garbage: $_\n";
    next;
  }

  $seq++;
  # Get user name from uucp path
  $from = $1 if $from =~ /.*!(.+)/;

  # Now, scan for Subject or empty line
  $subj = "";
  while ( <> ) {
    chop ($_);

    if ( /^$/ || /^From / ) {
      # force fall-though
      $subj = "<none>" unless $subj;
    }
    else {
      $subj = $1 if /^Subject\s*:\s*(.*)/i;
      if ( /^From\s*:\s*/ ) {
        $_ = $';
        if ( /\((.+)\)/i ) { $from = $1; } 
        elsif ( /^\s*(.+)\s*<.+>/i ) { $from = $1; } 
        elsif ( /^<.+>\s*(.+)/i ) { $from = $1; } 
      }
    }

    # do we have enough info?
    if ( $from && $subj ) {
      write;
      last;
    }
  }
}

--
Martin Boyer                            mboyer at ireq-robot.hydro.qc.ca
Institut de recherche d'Hydro-Quebec    mboyer at ireq-robot.uucp
Varennes, QC, Canada   J3X 1S1
+1 514 652-8412