#!/usr/bin/perl
#
# $Id: print-mail,v 1.6 2004/12/11 23:53:50 vogelke Exp $
#
# NAME:
#    print-mail
#
# SYNOPSIS:
#    print-mail [-dhv] files
#
# DESCRIPTION:
#    Write a mail message to stdout using mp Postscript.  Allows more
#    lines per page.
#
# OPTIONS:
#    "-d" prints debugging output to /tmp/print-mail.dbg.
#    "-h" prints help information and exits.
#    "-v" prints the current version and exits.
#
# AUTHOR:
#    Karl Vogel <vogelke@pobox.com>
#    Sumaria Systems, Inc.

eval 'exec perl -S $0 ${1+"$@"}'    # If the shell can't handle "#!",
  if 0;                             # fire up perl directly.

require "getopts.pl";               # command line args.

$ENV{"PATH"} = "/bin:/usr/sbin:/usr/local/bin";
$tmp = "/tmp/stuff.$$";
($myname) = split(/\//, reverse($0));
$myname = reverse($myname);         # script basename.

$debug_on      = 0;                 # 0=normal, 1=debugging output.
$saw_interrupt = 0;                 # 0=normal, 1=caught signal.

#
# Trap most common signals.
#

$SIG{'HUP'}  = 'sigcatcher';
$SIG{'INT'}  = 'sigcatcher';
$SIG{'QUIT'} = 'sigcatcher';
$SIG{'TERM'} = 'sigcatcher';

#
# Handle command line arguments (if any).
#

$opt_h = 1 unless &Getopts('dhv');
&synopsis if $opt_h;
&version  if $opt_v;

if ($opt_d) {
    $debug_on   = 1;
    $debug_file = "/tmp/$myname.dbg";
    open(DEBUG, "> $debug_file") || die "$debug_file: $!\n";
    print DEBUG "sample message\n" if $debug_on;
}

#
# Handle a file on the command line or stdin.
#

if ($file = shift @ARGV) {
    open(INPUT, "$file") || die "$file not found: $!";
}
else {
    open(INPUT, "<&STDIN");
}

&print_prologue();
&read_message_header();
&print_page_header();
&print_mail_header();

$count    = 5;     # because print_mail_header just printed 5 lines.
$pageno   = 1;
$maxlines = 67;    # fits comfortably on one page.

#
# Read MAXLINES lines, print body, then print a new header.
#

while (!eof(INPUT)) {
    &print_page_body($count, $maxlines);
    $count = 0;
    !eof(INPUT) && &print_page_header();
}

&print_trailer();
close(INPUT);
close(DEBUG) if $debug_on;
&exit(0);

#---------------------------------------------------------------------
#	Print a short usage message from the comment header and exit.
#

sub usage {
    if (open(PROG, "$0")) {
        while (<PROG>) { last if /^# NAME:/; }
        print STDERR " NAME:\n";

        while (<PROG>) {
            last if /^\s*$/;
            last if /^# AUTHOR:/;
            s/^#//;
            print STDERR;
        }

        close(PROG);
    }
    else { print STDERR "No usage information available.\n"; }
    &exit(1);
}

#---------------------------------------------------------------------
#	Print an optional message followed by a short synopsis of the
#	comment header.  Then exit with value 1.
#

sub synopsis {
    local ($msg) = @_;
    warn "\n$myname: $msg\n\n" if $msg;

    if (open(PROG, "$0")) {
        while (<PROG>) { last if /^# NAME:/; }
        print STDERR " NAME:\n";

        while (<PROG>) {
            last if /^\s*$/;
            last if /^# AUTHOR:/;
            s/^#//;
            print STDERR;
        }

        close(PROG);
    }
    else { print STDERR "No synopsis information available.\n"; }
    &exit(1);
}

#---------------------------------------------------------------------
#	Do something if we get a signal.
#

sub sigcatcher {
    local ($sig) = @_;
    &exit(2, "caught signal SIG$sig -- shutting down.\n");
}

#---------------------------------------------------------------------
#	Print the current version and exit.
#

sub version {
    $_ =
        '$RCSfile: print-mail,v $ $Revision: 1.6 $ '
      . '$Date: 2004/12/11 23:53:50 $';

    s/RCSfile: //;
    s/.Date: //;
    s/,v . .Revision: /  v/;
    s/\$//g;

    print "$_\n";
    exit(0);
}

#---------------------------------------------------------------------
#	Clean up.
#

sub exit {
    local ($code, $msg) = @_;
    unlink($tmp) unless $debug_on;

    warn "$myname: $msg\n" if $msg;
    exit($code);
}

# ------------------------------------------------------------------------
#
# Read until first blank line.  extract just the lines we need.
# Need to escape parens or PostScript gets upset.
# Also need to keep an eye out for page-feeds.

sub read_message_header {
    $pageno = 1;

    while (<INPUT>) {
        chop;
        last if /^$/;

        # This is tricky.  First escape any existing backslashes
        # so they'll print, then add backslashes in front of
        # existing parentheses so the parens will print as well.

        s/\\/\\\\/g;
        s/\(/\\(/g;
        s/\)/\\)/g;

        if (/^From: /) {
            s/^From: //g;
            $from = $_;
        }

        if (/^Subject: /) {
            s/^Subject: //g;
            $subject = $_;
        }

        if (/^To: /) {
            s/^To: //g;
            $to = $_;
        }

        if (/^Date: /) {
            s/^Date: //g;
            $date = $_;
        }
    }
}

# ------------------------------------------------------------------------

sub print_prologue {
    print <<"EndPrologue";
%!PS-Adobe-1.0
/localeprolog 0 def

%!PS-Adobe-1.0
%%Creator: Steve Holden
%%Modified: John Macdonald, Rich Burridge, Rainer Klute
%%Modified: Bertrand Decouty, Bjorn P. Brox
%%Title: @(#)mp.pro.ps 3.3 93/03/11
%%CreationDate: see above
%%PageLength 60
%%LineLength 80
%%DocumentFonts: Courier Helvetica-BoldOblique Times-Bold Times-Roman
%%Pages: (atend)
%%EndComments

%  @(#)mp.common.ps 3.1 92/04/03
%
%  Mp PostScript routines common to all prologue files.
%
%  The initial header comments are read (and output to stdout)
%  from the individual prologue file, then the contents of this
%  file are read (and output to stdout), then the remainder of
%  the individual prologue file.

/inch { 72 mul } bind def
%
%  IMPORTANT NOTE: The following two variables should be set correctly.
%                  Reasonable values for fullwidth and fullheight are
%                  8.5/11 inch for US Letter, and 8.5/11.4 inch for A4.
%                  Since sites usually have one single format of paper,
%                  mp should be installed with either the USLetter or A4
%                  values.
%
/fullwidth 8.5 inch def
/fullheight 11 inch def

% Define /ISOLatin1Encoding only if it's not already there.
/ISOLatin1Encoding where { pop save true }{ false } ifelse
  /ISOLatin1Encoding [ StandardEncoding 0 45 getinterval aload pop /minus
    StandardEncoding 46 98 getinterval aload pop /dotlessi /grave /acute
    /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring
    /cedilla /.notdef /hungarumlaut /ogonek /caron /space /exclamdown /cent
    /sterling /currency /yen /brokenbar /section /dieresis /copyright
    /ordfeminine /guillemotleft /logicalnot /hyphen /registered /macron
    /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph
    /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright
    /onequarter /onehalf /threequarters /questiondown /Agrave /Aacute
    /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute
    /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis /Eth
    /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply
    /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn
    /germandbls /agrave /aacute /acircumflex /atilde /adieresis /aring /ae
    /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave /iacute
    /icircumflex /idieresis /eth /ntilde /ograve /oacute /ocircumflex
    /otilde /odieresis /divide /oslash /ugrave /uacute /ucircumflex
    /udieresis /yacute /thorn /ydieresis ] def
{ restore } if

%Title: backspacefont.ps suggested by Glenn Reid (Adobe Systems).

/backspacefont {
    /CourierISO findfont dup length dict begin
        { %forall
            1 index /FID eq { pop pop } { def } ifelse
        } forall
        currentdict /UniqueID known { %if
              /UniqueID UniqueID 16#800000 xor def
        } if
        CharStrings length 1 add dict begin
            CharStrings { def } forall
          /backspace { -600 0 setcharwidth pop } bind def
            currentdict
      end
        /CharStrings exch def
        /Encoding Encoding 256 array copy def
        Encoding 8 /backspace put
        currentdict
    end
    definefont
} bind def

/reencodeISO { %def
    findfont dup length dict begin
    { 1 index /FID ne { def }{ pop pop } ifelse } forall
    /Encoding ISOLatin1Encoding def
    currentdict end definefont pop
} bind def

/fontHd_size 14 def
/fontH2_size 10 def
/fontNd_size 12 def

/setmargin {
  /leftedge 0 def
  /bottomedge 0 def
  fullheight fullwidth LandscapeMode { exch } if
    /rightedge exch def
    /topedge exch def
  9 7 LandscapeMode { exch } if pop
    /FontSize exch def

  0 localeprolog eq
  {
  /font1d /Times-Bold           reencodeISO
  /font2d /Times-Roman          reencodeISO
  /CourierISO /Courier          reencodeISO
  /fontHd /Helvetica-BoldOblique        reencodeISO
  /fontH2 /Helvetica-BoldOblique        reencodeISO
  /fontNd /Times-Bold           reencodeISO
  /font3d backspacefont
  /BoldFont      { /font1d findfont FontSize scalefont setfont } def
  /pf            { /font2d findfont FontSize scalefont setfont } def
  /sf            { /font3d findfont FontSize scalefont setfont } def
  /fontH         { /fontHd findfont fontHd_size scalefont setfont } def
  /fontD         { /fontH2 findfont fontH2_size scalefont setfont } def
  /fontN         { /fontNd findfont fontNd_size scalefont setfont } def
  }
  {
  /font1d /LC_Times-Bold def
  /font2d /LC_Times-Roman def
  /CourierISO /LC_Courier def
  /fontHd /LC_Helvetica-BoldOblique def
  /fontH2 /LC_Helvetica-BoldOblique def
  /fontNd /LC_Times-Bold def
  /font3d /LC_Courier def
  /BoldFont      { font1d findfont FontSize scalefont setfont } def
  /pf            { font2d findfont FontSize scalefont setfont } def
  /sf            { font3d findfont FontSize scalefont setfont } def
  /fontH         { fontHd findfont fontHd_size scalefont setfont } def
  /fontD         { fontH2 findfont fontH2_size scalefont setfont } def
  /fontN         { fontNd findfont fontNd_size scalefont setfont } def
  }
  ifelse

} def

/graybox	% grey x1 y1 x2 y2 graybox --
{
    newpath
      4 -1 roll 2 copy			% y2 x1
      10 sub exch moveto
      4 -1 roll 2 copy			% x1 y1
      10 180 270 arc
      4 -1 roll 1 copy 3 -1 roll	% x2 y1
      10 270 0 arc
      3 -1 roll 1 copy 3 1 roll		% x1 y2 x2 y2
      10 0 90 arc
      10 90 180 arc
    closepath
    gsave
      setgray fill
    grestore
    0 setgray stroke
} bind def

/endpage		% page_number endpage --
{
  gsave
    % listing type, user, date across the top
    0.88                                % gray level
    leftedge  50 add topedge 56 sub     % bottom lt corner
    rightedge 95 sub topedge 36 sub     % top rt corner
    graybox

    currentdict /sfactor known not
    {
      % determine a suitable factor to scale down the header text (done
      % only once per document)
      rightedge 95 sub leftedge 50 add sub % available space
      fontD MailFor stringwidth pop
      fontH User    stringwidth pop add
            (  )    stringwidth pop add
      fontD TimeNow stringwidth pop add    % total length of strings
      div
      dup 1 gt {pop 1} if                  % does it fit?
      /sfactor exch def                    % if not scale down
    }
    if

    leftedge 50 add topedge 50 sub moveto
    gsave
    sfactor dup scale
    fontD MailFor show
    fontH User    show
          (  )    show
    grestore
    fontD
    rightedge 95 sub TimeNow stringwidth pop sfactor mul sub
    topedge 50 sub moveto
    gsave
    sfactor dup scale
    TimeNow show
    grestore
    % page number to the top right corner
    1                                   % gray level
    rightedge 70 sub topedge 56 sub     % bottom lt
    rightedge 50 sub topedge 36 sub     % top rt
    graybox
    fontD
    (Page) dup stringwidth
       topedge 40 sub exch sub                  % y-centered
       exch 2 div rightedge 60 sub exch sub     % x-centered
       exch moveto show
    fontH
    dup stringwidth
       topedge 58 sub exch sub                  % y-centered
       exch 2 div rightedge 60 sub exch sub     % x-centered
       exch moveto show
    0.88                                   % gray level
    leftedge  50 add bottomedge 50 add     % bottom lt corner
    rightedge 50 sub bottomedge 70 add     % top rt corner
    graybox
    fontH
    % compute x pos for centring
      % ((l+50) + (r-50)) / 2 is the page centre
      leftedge rightedge add 2 div
      % but we want to start at the beginning of the string, not the middle
      Subject stringwidth pop 2 div sub
    % y pos is simple
      bottomedge 54 add
      moveto
    Subject show
  grestore
%  PageSave restore      % restore *always* before showpage
  showpage		% display it
} bind def

/endcol			% page_number col_number endcol --
{
  pop			% get rid of col_number
  pop                   % get rid of page_number
  /ypos topedge 92 sub def
  /xpos rightedge leftedge sub 2 div def
  xpos ypos moveto
} bind def

/newpage	% page_number newpage --
{
  pop		% pageno
%  /PageSave save def
  LandscapeMode {setlandscape} if
  /lct 0 def
  /ypos topedge 92 sub def
  /xpos leftedge 50 add def
  xpos ypos moveto
  sf
} bind def

/setlandscape
{
  612 0 translate
  90 rotate
} bind def

/showline
{
  show
  /ypos ypos FontSize sub def
  xpos ypos moveto
} bind def

% see the trouble shooting section in the README for details on setscreen.
106 45 {dup mul exch dup mul add 1.0 exch sub} setscreen

/LandscapeMode false def

setmargin
%%EndProlog
EndPrologue
}

# ------------------------------------------------------------------------
#
# required variables:	$pageno
#			$from
#			$subject
#			$to
#			$date

sub print_mail_header {
    print <<"EndMail";
sf
BoldFont (From:) show pf ( $from) showline
BoldFont (To:) show pf ( $to) showline
BoldFont (Subject:) show pf ( $subject) showline
BoldFont (Date:) show pf ( $date) showline
BoldFont ( ) show pf ( ) showline
sf
EndMail
}

# ------------------------------------------------------------------------
#
# required variables:	$pageno
#			$from
#			$subject
#			$to
#			$date

sub print_page_header {
    print <<"EndHeader";
%%Page: ? $pageno
$pageno newpage
/MailFor (From) def
/User ( $from) def
/TimeNow ( $date) def
/Subject ( $subject) def
sf
EndHeader
}

# ------------------------------------------------------------------------
#
# Print MAXLINES lines for each page, followed by page trailer.
# Need to escape parens or PostScript gets upset.
# Also need to keep an eye out for page-feeds.

sub print_page_body {
    local ($count, $maxlines) = @_;

    while (<INPUT>) {
        chop;

        # This is tricky.  First escape any existing backslashes
        # so they'll print, then add backslashes in front of
        # existing parentheses so the parens will print as well.

        s/\\/\\\\/g;
        s/\(/\\(/g;
        s/\)/\\)/g;
        $_ = &tab_expand($_);

        print "($_) showline\n";
        $count++;

        if (/\f/) {
            s/\f//g;
            $count = $maxlines;
        }

        last if $count == $maxlines;
    }

    print "sf ($pageno) 1 endcol\n($pageno) endpage\n";
    !eof(INPUT) && $pageno++;
}

# ------------------------------------------------------------------------
#
# expand tabs.

sub tab_expand {
    local ($_) = shift;
    1 while s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
    return $_;
}

# ------------------------------------------------------------------------
#
# print last few lines.

sub print_trailer {
    print <<"EndTrailer";
%%Trailer
%%Pages: $pageno
EndTrailer
}