#!/usr/pkg/bin/perl

# All of the documentation and software included in this software distribution
# is copyrighted by Matthew C. Mead (mmead@goof.com).
# 
# Copyright 1996, Matthew C. Mead.  All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#    This product includes software developed by Matthew C. Mead.
# 4. Neither the name of the author nor the names of any co-contributors
#    may be used to endorse or promote products derived from this software
#    without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY MATTHEW C. MEAD ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO
# EVENT SHALL MATTHEW C. MEAD OR CO-CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
# INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY
# OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

use Date::Parse;

$maildir = shift;

if ($maildir eq "-h") {
    print "usage: mdfrm /path/toMaildir\n";
    print "       mdfrm Maildir == mdfrm ~/MailMaildir\n";
    print "       otherwise, mdfrm defaults to \$MAILDIR\n";
    print "       otherwise, mdfrm defaults to ~/Maildir\n";
    exit;
}

if (!$maildir) {
    $maildir = $ENV{'MAILDIR'};
}

if (!$maildir) {
    $maildir = "$ENV{'HOME'}/Maildir";
}

$maildir =~ s/^=/$ENV{'HOME'}\/Mail\//;

if (!(-d $maildir && -r $maildir && -x $maildir && -d "$maildir/cur" &&
      -r "$maildir/cur" && -x "$maildir/cur" && -d "$maildir/new" &&
      -r "$maildir/new" && -x "$maildir/new")) {
    print "Something is wrong with \"$maildir\".  Please check its structure and permissions.\n";
    exit;
}

opendir(DIR, "$maildir/cur");
@tmpfiles = map{$_ = "$maildir/cur/$_"} grep{!/(^\.$)|(^\.\.$)/} readdir(DIR);
@msgfiles = @tmpfiles;
closedir(DIR);
opendir(DIR, "$maildir/new");
@tmpfiles = map{$_ = "$maildir/new/$_"} grep{!/(^\.$)|(^\.\.$)/} readdir(DIR);
push(@msgfiles, @tmpfiles);
closedir(DIR);

@msgs = ( );

foreach $file (@msgfiles) {
    $from = "";
    $subject = "";
    $date = 0;
    open(INPUT, $file);
FILEINPUT:
    while(<INPUT>) {
	if (/^From:\s+(.*)$/i) {
	    $from = $1;
	    next FILEINPUT;
	}
	if (/^Subject:\s+(.*)$/i) {
	    $subject = $1;
	    next FILEINPUT;
	}
	if (/^Date:\s+(.*)$/i) {
	    $date = $1;
	    next FILEINPUT;
	}
	if (/^\s*$/) {
	    last FILEINPUT;
	}
	if ($from && $subject && $date) {
	    last FILEINPUT;
	}
    }

    close(INPUT);

    @tmp = ( str2time($date), $from, $subject );
    push(@msgs, [ @tmp ]);
}

foreach $msg (sort {$a->[0] <=> $b->[0]} @msgs) {
    if ($msg->[1] =~ /\s*"*([^"]*)"*\s*\<[a-zA-Z0-9._%-=]+@[a-zA-Z0-9._%-=]+\>/) {
	$from = $1;
    } elsif ($msg->[1] =~ /[a-zA-z0-9._%-=]+@[a-zA-Z0-9._%-=]+.*\("*([^"]*)"*\)/) {
	$from = $1;
    } else {
	$from = $msg->[1];
    }

    if (length($from) <= 24) {
	printf("%-24s  ", $from);
    } else {
	printf("%-.24s  ", $from);
    }

    if (length($msg->[2]) <= 53) {
	printf("%-53s\n", $msg->[2]);
    } else {
	printf("%-.53s\n", $msg->[2]);
    }
}
