mail

#!/usr/bin/perl

=begin metadata

Name: mail
Description: send and receive mail
Author: Clinton Pierce, clintp@geeksalad.org
License: perl

=end metadata

=cut


#
# Class that holds a couple of things for all of the
# other classes here.  Mostly 'cause they all need
# an AUTOLOAD and DESTROY, but they're all almost the same.
#
package PerlPowerTools::mailprog;

sub AUTOLOAD {
        my $self=shift;
        my $type=ref($self) or die "$self is not an object";

        my $name=$AUTOLOAD;
        $name=~s/.*://;
        unless (exists $self->{_permitted}->{$name} ) {
                die "Can't access '$name' field in class $type";
        }
        if (@_) {
                return $self->{$name}=shift;
        } else {
                return $self->{$name};
        }
}
sub DESTROY { }
1;
package
	mailer; # hide from PAUSE
@ISA=qw(PerlPowerTools::mailprog);

use IO::Socket;
use Sys::Hostname qw();

%mailer::fields=(
	  user => undef,
	  "hostname" => undef,
	  relayhost => undef,
	  replyaddr => undef,
	  "socket" => undef,
	);

sub new {
	my $class=shift;
	my $self={_permitted => \%mailer::fields, %mailer::fields};
	if (@_) {
		my $a;
		while(defined ($a=shift)) {
			$self->{$a}=shift;
		}
	}
	bless($self, $class);

	#
	# Ok, this is where I start making assumptions
	# I'm doing this by hand because of the PPT "requirement" that
	# only core-modules be used.  Mail::Mailer would be MUCH better
	# suited for this task IMHO...
	#
	if (! exists $ENV{REPLYADDR}) {
		# Find my name...
		if (! defined $self->user) {
			if (exists $ENV{USER} or exists $ENV{LOGNAME}) {
				if (exists $ENV{USER}) {
					$self->user($ENV{USER});
				} else {
					$self->user($ENV{LOGNAME});
				}
			} else {
				die "Your username is not defined.  \$USER or \$LOGNAME must be set.\n";
			}
		}
		# Find my address...
		if (! defined $ENV{HOSTNAME}) {
			my $hostname = Sys::Hostname::hostname();
			if (! $hostname) {
				die "Unable to find a reasonable hostname.  Use \$HOSTNAME.\n";
			}
			$self->hostname($hostname);
		} else {
			$self->hostname($ENV{HOSTNAME});
		}
		# Don't like this?  Too bad.  That's why ken gave us an environment...
		$self->replyaddr($self->user . "@" . $self->hostname);
	} else {
		$self->replyaddr($ENV{REPLYADDR});  # Better be valid!
	}
	my $emsg;
	if (! exists $ENV{RELAYHOST}) {
		# Expensive.  Check to see if this system answers SMTP
		$self->relayhost('localhost');
		$emsg="You did not specify an \$RELAYHOST\nor this system is not listening to SMTP\n";
	} else {
		$self->relayhost($ENV{RELAYHOST});
		$emsg="Unable to connect to the specified relay host\n";
	}
	$socket=IO::Socket::INET->new(
			PeerAddr => $self->relayhost,
			PeerPort => 25,
			Proto => "tcp",
			Type => SOCK_STREAM,
			Timeout => 15,
	);
	if (! $socket) {
		die $emsg;
	}
	my($ofh)=select($socket); $|=1; select($ofh);

	# Get the SMTP header
	$_=<$socket>;

	$self->socket($socket);   # Use this quickly, it may expire.
	return $self;
}
sub send {
	my $self=shift;
	my $message=shift;   # Full message object.


	# Ok, here we go.
	my $sock=$self->socket;
	main::debug("Mailed from " . $self->replyaddr);
	print $sock "mail from: " . $self->replyaddr . "\n";  $_=<$sock>;
	{
	   if (defined $message->to) {
		foreach my $recipient (@{$message->to}) {
			main::debug("Sending to recipient $recipient");
			print $sock "rcpt to: $recipient\n";
			$_=<$sock>; main::debug("reply: $_");
		}
	   } else {
		die "No recipient.\n";
	   }
	   if (defined $message->cc) {
		foreach my $recipient (@{$message->cc}) {
			main::debug("Sending to recipient $recipient");
			print $sock "rcpt to: $recipient\n";
			$_=<$sock>; main::debug("reply: $_");
		}
	   }
	   if (defined $message->bcc) {
		foreach my $recipient (@{$message->bcc}) {
			main::debug("Sending to recipient $recipient");
			print $sock "rcpt to: $recipient\n";
			$_=<$sock>; main::debug("reply: $_");
		}
	   }
  	   my($to,$cc);
	   $to=join(', ', @{$message->to});
	   print $sock "data\n";    $_=<$sock>;
	   if ($to) {
		print $sock "To: $to\n";
	   }
	   if (defined $message->cc) {
		$cc=join(', ', @{$message->cc});
		print $sock "Cc: $cc\n";
	   }
	   if ($message->subject) {
		print $sock "Subject: " . $message->subject . "\n";
	   }
	   print $sock "X-Mailer: Perl Power Tools mail v", $main::VERSION, "\n\n";
           print $sock $message->body;
	   print $sock "\n.\n";
	   $_=<$sock>;
	   main::debug("received after body: $_");
	}
}
sub DESTROY {
	my $self=shift;

	if (defined $self->socket) {
		my $sock=$self->socket;
		close($sock);
	}
}
1;
package
	message; # hide from PAUSE
@ISA=qw(PerlPowerTools::mailprog);

%message::fields=( subject => undef,
	  from => undef,
	  deleted => undef,
	  "read" => undef,
	  neverseen => undef,
	  to => undef,
	  bcc => undef,
	  cc => undef,
	  lines => undef,
	  bytes => undef,
	  date => undef,
	  status => undef,
	  sequence => undef,
	);

sub new {
	my $class=shift;
	my $self={_permitted => \%message::fields, %message::fields};

	bless($self, $class);
	return $self;
}
sub load_from_array {   # Already chomped.
	my $self=shift;

	my($l, @head, @body);
	$self->lines(scalar @_);
	my $bytes;
	foreach(@_) {
		$bytes+=length($_);
	}
	$bytes+=($self->lines)*length($/);  # Correct for chomp.
	$self->bytes($bytes);
	while($l=shift) {
		push(@head, $l)
	}
	@body=@_;

	push(@{$self->{body}}, @body);
	push(@{$self->{head}}, @head);
	$self->_extract;
}
sub _extract {
	my $self=shift;

	foreach(@{$self->{head}}) {
		unless (/^\s+/) {
			push(@hc, $_);
		} else {
			$hc[$#hc].=$_;
		}
	}
	$self->neverseen(1);
	$self->read(0);
	while ($line=shift @hc) {
		my($foo, $bar);
		if (($foo)=$line=~/^Subject:\s+(.*)/i) {
			$self->subject($foo);
		}
		# Ok, so beat me over the head with an FAQ.
		if (($foo)=$line=~/^To:\s+(.*)/i) {
			my @toaddrs;
			$foo=~s/"[^"]+"//g;   # Remove comments?
			foreach my $addtest (split(/[,\s]+/, $foo)) {
				$addtest=~s/^\s+//g; $addtest=~s/\s$//g;
				next if (! $addtest);
				if ($addtest=~/<(.*)>/) {
					push(@toaddrs, $1);
				} elsif ($addtest=~/(\w+@[\w.]+)/){
					push(@toaddrs, $1);
				} else {
					push(@toaddrs, $addtest);
				}
			}
			$self->to([@toaddrs]);
		}
		if (($foo)=$line=~/^CC:\s+(.*)/i) {
			my @toaddrs;
			$foo=~s/"[^"]+"//g;   # Remove comments?
			foreach my $addtest (split(/[,\s]+/, $foo)) {
				$addtest=~s/^\s+//g; $addtest=~s/\s$//g;
				next if (! $addtest);
				if ($addtest=~/<(.*)>/) {
					push(@toaddrs, $1);
				} elsif ($addtest=~/(\w+@[\w.]+)/){
					push(@toaddrs, $1);
				} else {
					push(@toaddrs, $addtest);
				}
			}
			$self->cc([@toaddrs]);
		}
		if (($foo,$bar)=$line=~/^From\s+(.*)\s+(\w{3}\s+\w{3}\s+\d+\s+\d+:\d+):\d+\s+\d+$/i) {
			$self->date($bar);
			$self->from($foo);
		}
		if (($foo)=$line=~/^Status:\s+(.*)/i) {
			$foo=~/O/ and $self->neverseen(0);
			$foo=~/R/ and $self->read(1);
		}
	}
	$self->deleted(0);
}
sub add_to_body {
	my $self=shift;

	push(@{$self->{body}}, @_);
}
sub _printablestatus {
	my $self=shift;

	return("X") if ($self->deleted);
	return(" ") if ($self->read);
	return("N") if ($self->neverseen);
	return("U");
}
sub outputstatus {     # Why the hell mail uses one status flag in the file,
	my $self=shift; # and a _different_ one onscreen escapes me.  Lunacy.

	my $status;
	$status.="R" if ($self->read);
	$status.="O";
	return($status);
}

# Given a message, return a 1 line summary, takes sequence # as arg
sub summary {
	my $self=shift;

	my $line=sprintf "%2s %2d %16s  %16s %3d/%4d ",
		$self->_printablestatus,
		$self->sequence,
		(defined $self->from)?substr($self->from, 0, 16):" ",
		(defined $self->date)?$self->date:" ",
		$self->lines,
		$self->bytes;

	if (defined $self->subject) {
		$line.=substr($self->subject, 0, $main::COLS-length($line)-1);
	} else {
		$line.="(no subject)";
	}
	return($line);

}
sub printhead {
	my $self=shift;

	$self->read(1);
	return join("\n", grep(!/^Status:/i, @{$self->{head}}));
}
sub body {
	my $self=shift;

	$self->read(1);
	return join("\n", @{$self->{body}} );
}
sub whole {
	my $self=shift;
	my $lines=shift;

	$self->read(1);
	if (! defined $lines) {
		return 	join("\n", grep(!/^Status:/i, @{$self->{head}}), "",@{$self->{"body"}});
	} else {
		return 	join("\n", ( grep(!/^Status:/i, @{$self->{head}}), "",@{$self->{"body"}})[0..$lines] );
	}
}
1;
#
# Class to hold info about the mailbox.
#
package
	mailbox; # hide from PAUSE
@ISA=qw(PerlPowerTools::mailprog);
use vars qw($AUTOLOAD %fields);

%mailbox::fields=( size => undef, file => undef, append => undef);

sub new {
	my $class=shift;
	my $self={_permitted => \%mailbox::fields, %mailbox::fields};
	if (@_) {
		my $a;
		while(defined ($a=shift)) {
			$self->{$a}=shift;
		}
	}
	# Ok, this is here 'cause I want the displayed message numbers to
	# match the offsets in the array.  (Saves headaches later, believe it
	# or not.)
	@{$self->{messages}}="Invalid";

	bless($self, $class);
	return $self;
}
sub load {
	my $self=shift;

	print "Loading the mailfile ", $self->file, "\n";
	my $start=1;
	unless (defined $self->file) {
		die "No mailbox specified\n";
	}
	if (-d $self->file) {
		warn $self->file . ": is a directory\n";
		return;
	}
	unless (open MBOX, '<', $self->file) {
		warn $self->file . ": cannot open: $!\n";
		return;
	}
	$self->size(-s $self->file);
	my @MESS=();
	while(<MBOX>) {
		chomp;
		if (@MESS and /^From /) {
			my $message=message->new;
			$message->load_from_array(@MESS);
			$message->sequence($start++);
			push(@{$self->{messages}}, $message);
			@MESS=();
		}
		push(@MESS, $_)
	}
	if (@MESS) {
		my $message=message->new;
		$message->load_from_array(@MESS);
		$message->sequence($start++);
		push(@{$self->{messages}}, $message);
	}
	close(MBOX);
	return 1;
}
sub stuff {
	my $self=shift;

	push(@{$self->{messages}}, $_[0]);
	$self->size(0);
}
sub write {
	my $self=shift;
	my $wa=shift;

	my $mode = exists $$wa{append} ? '>>' : '>';
	my $alt_msg="\"" . $self->file . "\" ";
	$alt_msg.=(-e $self->file)?"[Appended]":"[New File]";
	if (!open(MBOX, $mode, $self->file)) {
		warn "Failed to write to ", $self->file, ": $!\n";
		return;
	}
	my $bytes=(-s $self->file);   # cheat
	my $lines;
	foreach(1..$self->lastmsg) {
		my $message=$self->messagex($_);
		next if ($message->deleted);

		if (! exists $$wa{bodyonly}) {
			my $foo=$message->printhead;
			print MBOX $foo, "\n";
			$lines+=$foo=~tr/\n//;

			print MBOX "Status: ", $message->outputstatus, "\n";
			$lines+=1;
		}

		$foo=$message->body;
		print MBOX "\n", $foo, "\n";
		$lines+=$foo=~tr/\n//;
		$lines+=2;

		if (exists $$wa{unread}) {
			$message->read(0);
		}
	}
	close(MBOX);
	$bytes=(-s $self->file) - $bytes;
	$alt_msg.=" $lines/$bytes";

	return($alt_msg, undef);
}
sub messagex {
	my $self=shift;

	my $num=shift;
	if ($num<=0) {
		die "Invalid message specification, $num (Should Not Happen)";
	}

	return(${$self->{messages}}[$num]);
}
sub replace {
	my $self=shift;
	${$self->{messages}}[$_[0]]=$_[1];   # Replace that message
}
sub lastmsg {
	my $self=shift;
	return(scalar( @{$self->{messages}} )-1)
}
sub nextmsg {              # Returns sequence number of next (not deleted) message
	my $self=shift;
	my $current=shift;

	my $msg;
	while($msg=$self->messagex($current)) {
		if (! defined $msg) {
			return undef;
		}
		if ($msg->deleted) {
			$current++;
			next;
		}
		last;
	}
	return($current);
}
1;
package
	editor; # hide from PAUSE
@ISA=qw(PerlPowerTools::mailprog);

use File::Temp;

%editor::fields=(message => undef, mesgno => undef);
sub new {
	my $class=shift;
	my $self={_permitted => \%editor::fields, %editor::fields};
	if (@_) {
		my $a;
		while(defined ($a=shift)) {
			$self->{$a}=shift;
		}
	}

	bless($self, $class);
	return $self;
}
sub edit {
	my $self=shift;
	my $args=shift;

	my $msg=$self->message;
	if (! defined $msg) {
		die "Should Not Happen, edit without message";
	}
	if (exists $$args{subject}) {
		my $subj;
		print "Subject: ";
		$subj=<STDIN>; chomp($subj);
		$msg->subject($subj);
	}
	my($line,$tilde,$cmd,$arg);
	my @BODY;
EDLOOP: {
		$line=<STDIN>;
		if ( (not defined $line) or ($line=~/^\.\s+$/)) { last EDLOOP; }

		chomp $line;
		unless ( $line=~/^~[^~]/) {
			$line=~s/^~+/~/g;   # Extra tildes changed to one.
			push(@BODY, $line);
			redo EDLOOP;
		}
		($tilde,$cmd,$arg)=$line=~/(~)(.)\s*(.*)?/;
		warn "Bad line" if (! defined $tilde);
		$_=$cmd;
		SWITCH: {
			/s/ && do { $msg->subject($arg); last SWITCH; };
			/q/ && do { return; };
			/\!/ && do { system($arg); last SWITCH; };
			/c/ && do {
					my $ccs=$msg->cc;
					push(@{$ccs}, split(/[\s,;]+/, $arg));
					$msg->cc($ccs);
					last SWITCH;
				};
			/b/ && do {
					my $ccs=$msg->bcc;
					push(@{$ccs}, split(/[\s,;]+/, $arg));
					$msg->bcc($ccs);
					last SWITCH;
				};
			/t/ && do {
					my $tos=$msg->to;
					push(@{$tos}, split(/[\s,;]+/, $arg));
					$msg->to($tos);
					last SWITCH;
				};
			/m/ && do {
					my $msgs=main::parse_msg_list($arg,$self->mesgno);
					foreach(@$msgs) {
						my $rmsg=$main::box->messagex($_);
						next if (! defined $rmsg);
						push(@BODY, grep(s/^/> /g, split(/\n/, $rmsg->whole)));
					}
					last SWITCH
				};
			/f/ && do {
					my $msgs=main::parse_msg_list($arg,$self->mesgno);
					foreach(@$msgs) {
						my $rmsg=$main::box->messagex($_);
						next if (! defined $rmsg);
						push(@BODY, split(/\n/, $rmsg->whole));
					}
					last SWITCH;
				};
			/r/ && do {
				open(F, '<', $arg) || do { warn "Unable to open $arg: $!\n"; last SWITCH; };
				my $bytes=(-s $arg);
				my(@FOO)=<F>;
				close(F);
				chomp(@FOO);
				push(@BODY, @FOO);
				print "read $arg $bytes bytes\n";
			};
			/v/ && do {
				my $vipath = main::vipath() || last SWITCH;
				my $tmp = File::Temp->new;
				my $tmpfile = $tmp->filename;
				@BODY=grep(s/$/\n/g, @BODY);
				print { $tmp } @BODY;
				my $rc = system($vipath, $tmpfile);
				if ($rc != 0) {
					warn "Failed to execute '$vipath': $!\n";
					last SWITCH;
				}
				open(F, '<', $tmpfile) || die "Unable to re-open $tmpfile: $!";
				@BODY=<F>;
				chomp(@BODY);
				close(F);
				print "(Continued)\n";
			};
		}
	redo EDLOOP;
	}
	$msg->add_to_body(@BODY);
	$self->message($msg);
	return($self->message);
}

1;
package main;

use English;
use File::Temp;
use Getopt::Std;
use vars qw($VERSION $ROWS $BUFFERL $box);

$VERSION="0.02";
$ROWS=23;         # Screen Dimensions.  Yeah, this sucks.
$COLS=80;
$BUFFERL=2;	  # Lines needed for "fluff"

%commands=(
	"chdir"  => { alias => 'c',           args => 'path',                           },
	copy     => { alias => 'co',          args => 'msg,path', func => \&msg_copy    },
	"delete" => { alias => 'd',           args => 'msg',      func => \&msg_delete  },
	"exit"   => { alias => 'ex,x',                            func => sub { exit; } },
	from     => { alias => 'f',           args => 'msg',      func => \&from        },
	headers  => { alias => 'h',           args => 'msg',      func => \&listing     },
	hold     => { alias => 'ho,preserve', args => 'msg',      func => \&unread      },
	mail     => { alias => 'm',           args => 'addr',     func => \&mail        },
	"next"   => { alias => 'n',                               func => \&msg_next    },
	"print"  => { alias => 'p',           args => 'msg',      func => \&msg_print   },
	quit     => { alias => 'q', 		                      func => \&quit        },
	reply    => { alias => 'r',           args => 'msg',      func => \&replyCC     },  # Weird.
	Reply    => { alias => 'R',           args => 'msg',      func => \&reply       },
	save     => { alias => 's',           args => 'msg,path', func => \&msg_save    },
	shell    => { alias => 'sh', 		                      func => \&shell       },
	top      => {                                             func => \&top         },
	undelete => { alias => 'u',           args => 'msg',      func => \&undelete    },
	unread   => { alias => 'U',           args => 'msg',      func => \&unread      },
	visual   => { alias => 'v',           args => 'msg',      func => \&visual      },
	"write"  => { alias => 'w',           args => 'msg,path', func => \&msg_write   },
);

$SET::toplines=5;

#
# Funcs which implement all that garbage above.
#
sub listing {
	my ($first)=@_;   # Pass in a mailbox, current message

	$first=$$first[0];
	foreach($first..$first+$ROWS-$BUFFERL) {
		$message=$box->messagex($_);
		if (! defined $message) {
			warn "Invalid message number: $first\n" if ($_ == $first);
			last;
		}
		print $message->summary, "\n";
	}
	return $first;
}
sub vipath {
	return $ENV{'VISUAL'} if (defined $ENV{'VISUAL'});
	my $default = '/usr/bin/vi';
	return $default if (-x $default);
	warn "No VISUAL in environment\n";
	return;
}
sub shell {
	# How to get an interactive shell in Perl.  Hmmm...
	system("/bin/sh");   # For now.  :-)
}
sub mail {
	my($list,$mesgno)=@_;   # Target addresses
	my $msg=message->new;
	$msg->to($list);    # For whom the message tolls
	my $editor=editor->new;
	$editor->mesgno($mesgno);
	$editor->message($msg);
	$msg=$editor->edit({ subject => 1});
	if (! defined $msg) {
		print "Aborted\n";
		return;
	}
	my $mailer=mailer->new;
	$mailer->send($msg);
}
sub replyCC {
	my($list)=@_;   # Target addresses

	my(@ccaddrs, @replies, $subj, $tc);
	foreach(@$list) {
		my $original=$box->messagex($_);
		next if (!defined $original);
		if (! $subj) {
			$subj=$original->subject;
			unless ($subj=~/^re:/i) {
				$subj="re: $subj";
			}
		}
		push(@replies, $original->from);
		$tc=$original->cc;
		push(@ccaddrs, @$tc);
	}

	my $msg=message->new;
	$msg->to(\@replies);    # For whom the message tolls
	$msg->cc(\@ccaddrs);
	$msg->subject($subj);
	my $editor=editor->new;
	$editor->mesgno(@{$list}[0]);   # Use just the FIRST
	$editor->message($msg);
	print "To: ", join(',', @replies), "\n";
	if (@ccaddrs) {
		print "Cc: ", join(',', @ccaddrs), "\n";
	}
	print "Subject: $subj\n";
	$msg=$editor->edit;
	if (! defined $msg) {
		print "Aborted\n";
		return;
	}
	my $mailer=mailer->new;
	$mailer->send($msg);
}
sub reply {
	my($list)=@_;   # Target addresses

	my(@replies, $subj);
	foreach(@$list) {
		my $original=$box->messagex($_);
		next if (!defined $original);
		if (! $subj) {
			$subj=$original->subject;
			unless ($subj=~/^re:/i) {
				$subj="re: $subj";
			}
		}
		push(@replies, $original->from);
	}

	my $msg=message->new;
	$msg->to(\@replies);    # For whom the message tolls
	$msg->subject($subj);
	my $editor=editor->new;
	$editor->mesgno(@{$list}[0]);   # Use just the FIRST
	$editor->message($msg);
	print "To: ", join(',', @replies), "\n";
	print "Subject: $subj\n";
	$msg=$editor->edit;
	if (! defined $msg) {
		print "Aborted\n";
		return;
	}
	my $mailer=mailer->new;
	$mailer->send($msg);
}
sub quit {
	if ( (-s $box->file) != $box->size ) {
		warn "Mail folder has changed size, not writing\n";
	}
	$box->write;
	exit;
}
sub visual {
	my($list)=@_;

	my $cmd = vipath() || return;
	foreach my $msgno (@$list) {
		$message=$box->messagex($msgno);
		if (! defined $message) {
			warn "Invalid message number: $msgno\n";
			return;
		}
		my $tmp = File::Temp->new;
		my $path = $tmp->filename;
		my $tmbox = mailbox->new('file' => $path);
		$tmbox->stuff($message);
		$tmbox->write;
		my $rc = system($cmd, $path);
		if ($rc != 0) {
			warn "Failed to execute '$cmd': $!\n";
			return;
		}
		$tmbox2 = mailbox->new('file' => $path);  # Hope this isn't a leak
		$tmbox2->load;
		$box->replace($msgno, $tmbox2->messagex(1));
	}
}
sub from {
	my ($list)=@_;
	my $lastgood;
	foreach my $msgno (@$list) {
		$message=$box->messagex($msgno);
		if (! defined $message) {
			warn "Invalid message number: $msgno\n";
			return;
		}
		print "Message: ", $message->sequence, "\n";
		print $message->printhead, "\n";
		$lastgood=$msgno;
	}
	return $lastgood;
}
sub top {
	msg_print(@_, $SET::toplines);
}
sub msg_print {
	my ($list, $dummy, $nlines)=@_;
	my $lastgood;
	foreach my $msgno (@$list) {
		$message=$box->messagex($msgno);
		if (! defined $message) {
			warn "Invalid message number: $msgno\n";
			return;
		}
		print "Message: ", $message->sequence, "\n";
		print $message->whole($nlines), "\n";
		$lastgood=$msgno;
	}
	return $lastgood;
}
sub unread { toggle(@_, 'unread'); }
sub undelete { toggle(@_, 'undelete'); }
sub msg_delete { toggle(@_, 'delete'); }
sub toggle {
	my ($msgs, $dumb, $option)=@_;

	foreach my $msgno (@$msgs) {
		$message=$box->messagex($msgno);
		if (! defined $message) {
			warn "Invalid message number: $msgno\n";
			return;
		}
		if ($option eq 'unread') {
			$message->read(0);
		}
		if ($option eq 'undelete') {
			$message->deleted(0);
		}
		if ($option eq 'delete') {
			$message->deleted(1);
		}
	}
	return;
}
sub msg_next {
	my($first)=@_;
	$first=$$first[0];

	my $nmsg=$box->nextmsg($first);
	if (! defined $nmsg) {
		warn "At EOF\n";
		return;
	}
	my $ret=msg_print([ $nmsg ]);
	return ++$nmsg if (defined $ret);
	return;
}
sub msg_save { msg_store(@_, { append => 1 }); }
sub msg_copy { msg_store(@_, { append => 1, "unread" => 1,} ); }
sub msg_write {	msg_store(@_, { append => 1, bodyonly => 1,} ); }

sub msg_store {
	my($msgs, $file, $options)=@_;

	print "Saving message...$msgs to $file\n";
	my $tempbox=mailbox->new(file => $file);
	foreach my $msg (@$msgs) {
		$message=$box->messagex($msg);
		if (! defined $message) {
			warn "Invalid message number: $msg\n";
			return;
		}
		$tempbox->stuff($message);
	}
	my($short, $long)=$tempbox->write( $options );
	print "$short\n";
}
#
# Helpers for Interactive();
#
sub parseargs {
	my($cmd, $mesgno)=@_;
	my($cref)=undef;
	my $word=$cmd;
	$word=~s/^([a-zA-Z]+).*/$1/;
	foreach (keys %commands) {
		if ($word eq $_) {
			$cref=$commands{$_};
		} elsif (exists $commands{$_}{alias}) {
			if (grep($word eq $_, split(/,/, $commands{$_}{alias}))) {
				$cref=$commands{$_};
			}
		}
	}
	return if (! defined $cref);
	if (! exists $$cref{args}) {   # No arguments to speak of.
		return($word, $$cref{func}, [ $mesgno ]);   # Always return current...
	}
	# Arguments.  Deal with them
	if ($$cref{args}=~/msg,path/) {  # Multiples
		my $list=$cmd;  $list=~s/^[a-zA-Z]+//g;
		my($arg1,$arg2)=$list=~/(.*)\s+([^\s+]+)$/;
		$arg1=parse_msg_list($arg1, $mesgno);
		return($cmd, $$cref{func}, $arg1, $arg2);
	}
	if ($$cref{args} eq 'addr') {
		my $list=$cmd;  $list=~s/^[a-zA-Z]+\s*//g;
		my @foo=split(/[\s,;]+/, $list);
		return($cmd, $$cref{func}, [ @foo ], $mesgno);
	}
	if ($$cref{args} eq 'msg') {
		# Remove the word at the beginning
		my $list=$cmd;
		$list=~s/^[a-zA-Z]+//g;
		my $msglist=parse_msg_list($list, $mesgno);
		return($cmd, $$cref{func}, $msglist);
	}
}
# Accepts empty, Accepts lists of space or comma-seperated numbers
# Accepts ranges (1-5), Accepts offsets (+1, -5), Special
# $=last message *=all messages
sub parse_msg_list {
	my($list, $current)=@_;

	$list =~ s/^\s+//g;
	$list =~ s/\s$//g;
	return [ $current ] if (length($list) == 0);

	# Get ugly.
	my @list=();
	foreach my $stuff (split(/[, ]+/, $list)) {
		$stuff="1-\$" if ($stuff=~/^\*$/);
		$stuff=~s/\$/($box->lastmsg)-1/e;
		push(@list, $stuff) if ($stuff=~/^\d+$/);
		push(@list, $1..$2) if ($stuff=~/^(\d+)-(\d+)/);
	}
	return(\@list);
}
#
# All of the interactive stuff is here...
#
sub Interactive {
	my($file)=@_;
	$box=mailbox->new(file => $file);
	if (! $box->load ) {
		print "You have no mail\n";
		exit;
	}
	my $current=1;

	select STDOUT; $|=1;
	print "Mail [$VERSION Perl] [$OSNAME]\n";   # This is fluff.
	$cmd="Init";

CMDS:	{
		if ($cmd eq "Init") {
			$cmd="h";
		} else {
			print "> ";
			$cmd=<STDIN>;
			chomp $cmd;
		}
	GOTONE: {
			if ($cmd=~/^[a-zA-Z]+/) {
				($cmd, $fref, $arg1, $arg2)=parseargs($cmd, $current);
				if (! defined $cmd) {
					warn "Unknown command $cmd\n";
					redo CMDS;
				}
				if (! defined $fref) {
					warn "Unimplemented command $cmd\n";
					redo CMDS;
				}
				$current=&$fref($arg1, $arg2);
				if (! defined $current) {
					$current=1;
				}
			} elsif ($cmd=~/^!(.*)/) {
				system("$1");
			} elsif ($cmd=~/^[0-9]/) {
				$cmd="p $cmd";
				redo GOTONE;
			} elsif (! $cmd) {
				$cmd="p";
				redo GOTONE;
			} else {
				warn "Unknown command\n";
			}
		}
		redo CMDS;
	}
}
sub debug {
	if ($opt_v) {
                print STDERR @_, (($_[$#_]=~/\n$/)?"":"\n");
	}
}
sub Batch {
	my $message=message->new;
	$message->to([@_]);
	$message->cc([ split(/,/, $opt_c) ]) if ($opt_c);
	$message->bcc([ split(/,/, $opt_b) ]) if ($opt_b);
	$message->subject($opt_s) if ($opt_s);
	my $mailer=mailer->new;
	my @BODY=<STDIN>;
	chomp(@BODY);
	$message->add_to_body(@BODY);
	$mailer->send($message);
}
$main::opt_v=0;   # Keep -w quiet.
getopts("f:s:c:b:v") || die <<USAGE;
$0 [-f mailbox]
$0 [-s subject] [-c cc-addrs] [-b bcc-addrs] to-addr [..toaddr..]
USAGE

if (@ARGV) {   # Assume batch-mode
	Batch(@ARGV);
} else {
	if (defined $opt_f) {
		Interactive($opt_f);
	} else {
		if (exists $ENV{MAIL}) {
			Interactive($ENV{MAIL});
		} else {
			if (! exists $ENV{HOME}) {
				Interactive("mbox");
			} else {
				Interactive($ENV{HOME} . "/mbox");
			}
		}
	}
}

=pod

=head1 NAME

mail - implementation of Berkeley mail(1)

=head1 SYNOPSIS

mail [B<-f> mailbox]

mail [B<-s> subject] [B<-c> cc-addrs] [B<-b> bcc-addrs] to-addr [..toaddr..]

=head1 DESCRIPTION

When called without command-line options (except B<-f>) I<mail> allows the user to
interactively send mail, and manage a mail folder.  Otherwise, I<mail> allows
the user to send outgoing E-mail to recipients.

When run interactively, the mail folder ~/mbox is used.  If the home
directory cannot be determined, ./mbox is assumed.  This can be overridden
with the B<-f> option.

=head2 OPTIONS

I<mail> accepts the following options

=over 4

=item B<-f> mailbox

Specifies a mail folder to use.

=item B<-s> subject

Specify a subject for the mail message.

=item B<-c> cc-addrs

A I<comma-separated> list of addresses to be copied to on the mail message.

=item B<-b> bcc-addrs

A I<comma-separated> list of addresses to be copied to on the mail message,
without appearing in the headers.

=item to-addr

E-Mail destination addresses.  You may not be notified if mail fails to
deliver to the address properly.

=back

=head2 COMMANDS

In the list below, "msg" indicates a message list.  Acceptable values are comma or
space separated lists, ranges (i.e. 1-5) or single digits.  Special values are "$"
(end of list) and * (all messages).  If messages are unspecified, the current message
is used.  "path" indicates a filename argument.  "addr"
indicates a mail message address list (comma or space separated).

=over 4

=item number

Read message I<number>.

=item !command

Execute the "command" with the command interpreter.

=item copy msg path

Copy indicated messages (I<msg>) to filename at I<path>.
B<co> is an alias for this command.

=item delete msg

Delete indicated messages.
B<d> is an alias for this command.

=item exit

Exit the I<mail> program saving no changes to the mailbox.
B<x> is an alias for this command.

=item from msg

Display the headers from the specified messages.
B<f> is an alias for this command.

=item headers msg

Display a brief list of headers from the messages.
B<h> is an alias for this command.

=item hold msg

Mark messages as unread.  B<ho,preserve> are aliases for
this command.

=item mail addr

Send a mail message to addr.  B<m> is an alias for this command.

=item next

Print the next message in sequence.  B<n> is an alias for this command.

=item print msg

Print the specified mail message.  B<p,CR> are aliases for this command.

=item quit

Exit the mail program.  The (possibly) edited mailbox is re-written to
its original file.  See B<Bugs>.  B<q> is an alias for this command.

=item reply msg

Reply to the original sender of I<msg>.  B<r> is an alias for this command.

=item Reply msg

Reply to the original sender, and all visible recipients of I<msg>.
B<R> is an alias for this command.

=item save msg path

Save I<msg> into the file specified at I<path>.  If the file exists, it
is appended.  B<s> is an alias for this command.

=item shell

Start an interactive I<bourne> shell.  (This does not work under Win32).
B<sh> is an alias for this command.

=item top

Display the first few lines of the current mail message.

=item undelete msg

Mark as undeleted any specified mail messages.
B<u> is an alias for this command.

=item unread msg

Mark as unread any specified mail messages.
B<U> is an alias for this command.

=item visal msg

Invoke the visual editor (specified in $VISUAL, or /usr/bin/vi) on the
indicated messages.  Re-read those messages in afer the editing session.
B<v> is an alias for this command.

=item write msg path

Write the I<bodies> of the indicated messages to path.
B<w> is an alias for this command.

=back

=head2 EDITING COMMANDS

When sending a mail message (commands B<mail, reply or Reply>) a primitive
line-mode editor is used to get the body of the mail message, and possibly
change any header options.  During the editing session, special commands may
be used when typed at the beginning of the line.

To send the message, send an EOF character or a "." on a line by itself.

=over 4

=item ~ssubject

Change message subject to I<subject>.

=item ~q

Quit the message editor.  No changes are made, no message is sent.

=item ~caddr[,addr...]

Add the I<addr>s to the CC list for the message

=item ~baddr[,addr...]

Add the I<addr>s to the BCC list for the message

=item ~taddr[,addr...]

Add the I<addr>s to the To: list for the message

=item ~mmsg

Read the specified messages into the current message at the end.

=item ~fmsg

Read the specified messages into the current message at the end,
indenting each line with the sequence "> ".

=item ~rfile

Read the contents of I<file> into the message.

=item ~v

Invoke the visual editor on the message.  When the user is done
editing the message, read the message back in, and continue editing
at the end.

=back

=head1 BUGS

Numerous.  Mostly lack of refinement in the implementation, any of
which can be fixed without hassle, I'm sure.

=over 4

=item *

Many (many, many..) features left unimplemented.  Command-line,
commands and editing functions have all been decimated. I only implemented what
I thought was useful.  I<BSD mail> had many years to develop its many
tentacles.  I don't have that kind of patience.

=item *

Keeping track of the "current" message in the mail folder is sloppy.

=item *

Screen length is assumed to be 23 characters.  Width is 79.

=item *

Argument parsing doesn't ensure sane (and legal) combinations.

=item *

There is B<no> file locking.  Of anything.  You wanna re-write the
mailbox and there's local delivery going on?  Fine.  Have fun.  I<mail>
will refuse to write back a mailbox whose size has changed however...

=item *

I<mail> doesn't act as a Local Delivery Agent.

=item *

I<mail>'s method of picking through mail message headers to find from, to
and cc addresses violates several FAQ's, RFC's, and is void where prohibited.
Also easy to fix, I simply ran out of patience.  See the _extract method in the
message class if you're adventuresome.

=item *

To perform delivery, mail searches for C<$USER> or C<$LOGNAME> in your environment to see who
you are (for a From address).  It then searches for an SMTP agent on localhost.
Not finding that, it wants $RELAYHOST set to your SMTP relaying host name.  Your
reply address is taken from $REPLYADDR or your system's environment.  Whichever
is easier.  Win32 systems, be prepared to setup your environment properly for
this to work!

=item *

...speaking of SMTP... I<mail> talks directly to SMTP instead of using a more
sane method like Mail::Mailer.  This was done so that PPT mail(1) could remain
"pure" and un-encumbered by external modules.

=item *

This code is not "use strict" safe.  Although there's not much keeping it from
being "use strict" safe.  Use of package-based variables will probably get me
thumped from Tom.

=back

=head1 AUTHOR

The Perl implementation of I<mail> was written by
Clinton Pierce, I<clintp@geeksalad.org>.

=head1 COPYRIGHT and LICENSE

This program is Copyright 1999, by Clinton Pierce.

Freely redistributable under the Perl Artistic License.

=cut

1;