#!/usr/bin/perl
#########################################################################################
############################################################# waka, the mystic boat ####
######################################################################################
# Copyright (C) 2005-2008 Ing. Peter Grobner (waka@grobner.at)
#
# 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 or see <http://www.gnu.org/licenses/>.
#
#####################
 $VERSION=20090515; # starting eml2html by refactoring parts of waka.cgi ...
 $VERSION=20101019; # refactoring to "eml2pdf file1.eml file2.eml fileN.eml" ...
                    #
########################################################################################
my %UMLAUTE=( "Ä" => "&Auml;", "Ö" => "&Ouml;", "Ü" => "&Uuml;", "¤" => "&euro;",
              "ä" => "&auml;", "ö" => "&ouml;", "ü" => "&uuml;", "ß" => "&szlig;" );

my %CONF=   ( HTML_ENCODING  => 'iso-8859-15' );

########################################################################################
# here we go ...

use Encode; my $ENCODINGS=join '|',Encode->encodings();
use locale;
use POSIX qw(setlocale LC_ALL);

sub decodeMIME
{
 my($body)=@_;           $body=~s/\r//g;
 my               $head=($body=~s/(.+?)\n\n//s)? $1:'';
                  $head=~s/\n[ \t]/ /gs;
 my %header;      $head=~s/^([-\w]+):\s+(.*)$/$header{lc($1)}=encode($CONF{HTML_ENCODING},decode('MIME-Header',$2));''/gem;

 if($header{'content-transfer-encoding'}=~m{base64}i)
 {
  use MIME::Base64;      $body=decode_base64($body);
 }
 elsif($header{'content-transfer-encoding'}=~m{quoted-printable}i)
 {
  use MIME::QuotedPrint; $body=decode_qp($body);
 }

 my @parts=();

    $header{'CONTENT'}=  $body;

 if($header{'content-type'}=~/^multipart\/alternative.*?boundary="([^"]+)"/i)
 {
  my(@text,@html); my $boundary=quotemeta($1);

  foreach(split  /\n-+$boundary-*(\n|$)/s,$body)
  {
   my    @p=decodeMIME($_);

   @text=@p if($p[0]->{'content-type'}=~/^text\/plain/i);
   @html=@p if($p[0]->{'content-type'}=~/^text\/html/i);
  }
         @p=@html? @html:@text;                    push @parts,(\%header,@p);
 }
 elsif($header{'content-type'}=~/^multipart\/.*?boundary="([^"]+)"/i)
 {
                   my $boundary=quotemeta($1);

  foreach(split  /\n-+$boundary-*(\n|$)/s,$body) { push @parts,(\%header,decodeMIME($_)); }
 }
 else                                            { push @parts, \%header; }

 return @parts;
}

sub eml2html
{
  my @p=decodeMIME(join '',@_);                                                      $p[0]->{'mailto'}=$p[0]->{'from'};
                                                                                     $p[0]->{'mailto'}=~s/"//g;
                                                                                     $p[0]->{'from'}=~s/</&lt;/g;
                                                                                     $p[0]->{'from'}=~s/>/&gt;/g;
  my $content =qq{<table style="background-color: #ccc; width: 100%">};
     $content.=i18f("<tr><td><b><#Datum:#></b> %s</td></tr>",                        $p[0]->{'date'});
     $content.=i18f("<tr><td><b><#Von:#></b> <a href=\"mailto:%s\">%s</a></td></tr>",$p[0]->{'mailto'},
                                                                                     $p[0]->{'from'});
     $content.=i18f("<tr><td><b><#Betreff:#></b> %s</td></tr>",                      $p[0]->{'subject'});
     $content.=qq{</table>};

  foreach(@p)
  {
     $_->{'CONTENT'}=encode($CONF{HTML_ENCODING},decode($1,$_->{'CONTENT'})) if($_->{'content-type'}=~m{charset="?($ENCODINGS)}i);

   if($_->{'content-type'}=~m{^text/html}i)
   {
     $_->{'CONTENT'}=~s{^.*<body[^>]*>|</body>.*$}{}sg;

     $content.="<hr>$_->{'CONTENT'}";
   }
   elsif($_->{'content-type'}=~m{^text/plain}i)
   {
     $content.="<hr><pre>$_->{'CONTENT'}</pre>";
   }
   elsif($_->{'content-type'}=~m{name="([^"]+)"}i
   ||    $_->{'content-disposition'}=~m{filename="([^"]+)"}i)
   {
     my $file=$1; $file=~s/&amp;|[&?=:\\\/\s;]/~/sg;

     $content.=i18f(qq{<hr><#Anhang:#> $file});
   }
  }
     $content=~s/\{/&#34;/g;
     $content=~s/\}/&#35;/g; return $content;
}

sub i18f { my $f=shift; $f=~s/<#|#>//g; return sprintf($f,@_); }

foreach(@ARGV)
{
 if(/^(.*).eml$/i && open(EML,$_))
 {
  open(HTML2PDF,qq{|html2ps -u|ps2pdf - "$1.pdf"}); undef $/;

   printf HTML2PDF '<html><body>%s</body></html>',eml2html(<EML>);

  close(HTML2PDF);
  close(EML);
}}