#!/usr/local/bin/perl
# nextatt - Convert mail to NeXT format and add attachments
#	Brian Katzung	Revision 3.1	9 April 1994
#
# This software is provided on a strictly as-is basis.
# Use it at your own risk.
#
# usage:
#	Filter message (including header lines) through
#	"nextatt [-courier] [-helv] [-ohlfs] [-tf typeface]
#	    [-ps point_size] [path...]"
#
# When using /usr/ucb/mail, make sure the "editheaders" option is set.
# Then use ~e or ~v after composing your message to enter your editor and
# filter the message through nextatt.
#
# If you have sendmail, but you don't have an "editheaders" equivalent in
# your mailer, you can enter the message into a file with your favorite
# editor, run it through this filter, and pass the result to sendmail -t.
#
# Attachments may also be imbedded in the message body using lines of the
# form:
# \attach path...
# (the paths are globbed by sh)
#
# RTF (Rich Text Format) notes:
# Append a blank to lines in the middle of paragraphs, and a \ to the last
# line in a paragraph (and blank lines).
# Quote backslashes and braces (\ -> \\, { -> \{, and } -> \}).

eval "exec perl -S $0 $*"
if $isAShell;

$false = 0;
$true = 1;

######################################################################
# Add attachments to the attachment list
sub attach
{
	local($file);
	local($dir);

	foreach $file (@_)
	{
		next if $file eq '';
		# Add "-C dir" if file is not in current directory
		if (index($file, '/') >= 0)
		{
			($dir, $file) = $file =~ /(.*)\/(.*)/;
			$dir = "$baseDir/$dir" unless $dir =~ /^\//;
			push(@tarArgs, '-C', $dir);
			$didC = $true;
		}
		elsif ($didC == $true)
		{
			push(@tarArgs, '-C', $baseDir);
			$didC = $false;
		}
		push(@tarArgs, $file);
		print INDEX "{{\\attachment0 $file\n}\n";
	}
}

######################################################################
# Main program

# Process command line options
$type = 'swiss Helvetica';
$points = 10;

while ($ARGV[0] =~ /^-/)
{
	$opt = shift(@ARGV);
	if ($opt =~ /-courier/i)
	{
		$type = 'modern Courier';
	}
	elsif ($opt =~ /-helv/i)
	{
		$type = 'swiss Helvetica';
	}
	elsif ($opt =~ /-ohlfs/i)
	{
		$type = 'modern Ohlfs';
	}
	elsif ($opt =~ /-ps/)
	{
		$points = shift(ARGV);
	}
	elsif ($opt =~ /-tf/)
	{
		$type = shift(@ARGV);
	}
	else
	{
		@ARGV = ($opt, @ARGV);
		last;
	}
}

# Convert to half-points
$points *= 2;

# Look for the subject line in order to name the attachment.
$subject = 'no_subject';
while (<STDIN>)
{
	last if $_ eq "\n";
	print;
	if (/^subject:[	 ]*(..*)\n/i)
	{
		$subject = $1;
		$subject =~ s/[^A-Za-z0-9][^A-Za-z0-9]*/_/g;
		$subject = substr($subject, 0, 40);
	}
}

$tmp = "/tmp/na.$$";
$na = ".tar.$$.$subject.attach";
mkdir($tmp, 0700) ||
  die "Cannot create scratch directory: $tmp";

# RTF boilerplate
open(INDEX, ">$tmp/index.rtf") ||
  die "Cannot create file: $tmp/index.rtf";
print INDEX "{\\rtf0\\ansi{\\fonttbl\\f0\\f$type;}\n";
print INDEX "\\margl120\n\\margr120\n\\fs$points\n";

$baseDir = `/bin/pwd`;
chop($baseDir);
$didC = $true;

# Any attachments on the command line?
&attach(@ARGV) if $#ARGV >= 0;

# Copy the message body into the index.rtf file, looking
# for imbedded attachment requests as we go.
while (<STDIN>)
{
	if (/^\\attach (.*)\n/)
	{
		&attach((split("\n",
		  `sh -c 'for arg in $1;do echo "\$arg";done'`)));
	}
	else
	{
		print INDEX;
	}
}
close(INDEX);

# Create the compressed tar archive
@tarArgs = ('-C', $tmp, 'index.rtf', @tarArgs);
grep(s/'/'\\''/g, @tarArgs);
$tarArgs = "'" . join("' '", @tarArgs) . "'";
system("tar cf - $tarArgs | compress -f | uuencode \"$na\" > \"$tmp/$na\"");
$len = (stat("$tmp/$na"))[7];

# Add the Next-Attachment line to the header and then put in the body.
# Next-Attachment: file, length, nth/of, ?, offset_in_body
print "Next-Attachment: $na, ", $len, ", 1/1, 0, 0\n\n";
open(ARCHIVE, "<$tmp/$na");
while (<ARCHIVE>)
{
	print;
}
close(ARCHIVE);

# Clean up and then we're done
system("rm -rf \"$tmp\"");
exit 0;