print from and subject of messages in mailbox

#!/usr/bin/perl -w
'di ';
'ds 00 \"';
'ig 00 ';

#
# from - print from and subject of messages in mailbox
#
# Copyright (C) 1996-2003  Daniel Quinlan
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use Getopt::Std;
use MIME::Head;
use vars qw($opt_f);

getopt("f:");

@maildir = ("/var/mail", "/var/spool/mail", "/usr/spool/mail");

$prog = $0;
$prog =~ s@.*/@@;

$inbox = $opt_f || $ENV{'MAIL'};
$head = MIME::Head->new;

if (! $inbox) {
    $user = $ENV{'USER'} || getlogin;
    foreach $dir (@maildir) {
	if (-e "$dir/$user") {
	    $inbox = "$dir/$user";
	    last;
	}
    }
    if (! $inbox) {
	die "$prog: couldn't find mailbox\n";
    }
}

format =
@<<<<<<<<<<<<<<<<<<<<<<<<<  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$from[$j], $subject[$j]
.

$i = 0;

open(INBOX, "$inbox") || die "$prog: can't read $inbox\n";

while () {
    if (! $header && /^From /) {
	$header = 1;
	$afrom = "";
	$subject[$i] = "";
    }
    if ($header) {
	if (/^$/) {
	    $header = 0;
	    if (! $from[$i]) {
		$from[$i] = $afrom;
	    }
	    if ($from[$i] =~ /=\?/) {
		$head->replace('From', $from[$i]);
		$head->decode;
		$from[$i] = $head->get('From', 0);
	    }
	    $i++;
	}
	elsif (s/^From[ \t]+(\S+)//) {
	    $afrom = $1;
	}
	elsif (s/^From:[ \t]+//) {
	    if (/\((.*\w.*)\)/) {
		$from[$i] = $1;
	    }
	    elsif (/(.*\w.*)<.*>/) {
		$_ = $1;
		s/"(.*)"/$1/;
		$from[$i] = $_;
	    }
	    else {
		s/<(.*)>/$1/;
		$from[$i] = $_;
	    }
	}
	elsif (s/^Apparently-From:[ \t]+//) {
	    if (/\((.*\w.*)\)/) {
		$afrom = $1;
	    }
	    elsif (/(.*\w.*)<.*>/) {
		$_ = $1;
		s/"(.*)"/$1/;
		$afrom = $_;
	    }
	    else {
		s/<(.*)>/$1/;
		$afrom = $_;
	    }
	}
	elsif (/^Subject:[ \t]+/) {
	    s/^Subject:[ \t]+//;
	    if (/=\?/) {
		$head->replace('Subject', $_);
		$head->decode;
		$subject[$i] = $head->get('Subject', 0);
	    }
	    else {
		$subject[$i] = $_;
	    }
	}
    }
}

for ($j = 0; $j < $i; $j++) {
    write;
}
##############################################################################

# These next few lines are legal in both Perl and nroff.

# finish .ig
.00 ;

'di			\" finish diversion--previous line must be blank
.nr nl 0-1		\" fake up transition to first page again
.nr % 0			\" start at page 1
.\"'; __END__		\" From here on it's a standard manual page
.TH FROM 1 "Dec 15, 1996"
.SH NAME
from \- print from and subject of messages in mailbox
.SH SYNOPSIS
.BR from " [" -f
.IR file ]
.SH DESCRIPTION
from prints out the mail header lines from messages in an electronic
mailbox.
.SH OPTIONS
.TP
.BI "-f " file
Use
.I file
as the mailbox filename.
.SH ENVIRONMENT
.TP
.B MAIL
If this environment variable is set, it is used as the mailbox
filename.
.TP
.B USER
If this environment variable is set, it is used as the username.
.SH FILES
If the
.B MAIL
environment variable is not set, then the
.BR /var/mail ", " /var/spool/mail ", and " /usr/spool/mail
directories are checked (in that order) for a mailbox with a filename
identical to the username.  If the
.B USER
environment variable is not set, the
.BR getlogin (3)
function is used to determine the username.
.SH AUTHORS
Daniel Quinlan
.SH "SEE ALSO"
.BR biff (1),
.BR mail (1)
.SH BUGS
None.