finish adding a feature to easily list all email addresses for an agent & send them...
[freeside.git] / FS / FS / Misc.pm
index 231ef06..936f94a 100644 (file)
@@ -5,15 +5,17 @@ use vars qw ( @ISA @EXPORT_OK $DEBUG );
 use Exporter;
 use Carp;
 use Data::Dumper;
+use IPC::Run qw( run timeout );   # for _pslatex
+use IPC::Run3; # for do_print... should just use IPC::Run i guess
 #do NOT depend on any FS:: modules here, causes weird (sometimes unreproducable
 #until on client machine) dependancy loops.  put them in FS::Misc::Something
 #instead
 
 @ISA = qw( Exporter );
-@EXPORT_OK = qw( send_email send_fax
+@EXPORT_OK = qw( generate_email send_email send_fax
                  states_hash counties state_label
                  card_types
-                 generate_ps do_print
+                 generate_ps generate_pdf do_print
                );
 
 $DEBUG = 0;
@@ -38,36 +40,180 @@ but are collected here to elimiate code duplication.
 
 =over 4
 
+=item generate_email OPTION => VALUE ...
+
+Options:
+
+=item from
+
+Sender address, required
+
+=item to
+
+Recipient address, required
+
+=item subject
+
+email subject, required
+
+=item html_body
+
+Email body (HTML alternative).  Arrayref of lines, or scalar.
+
+Will be placed inside an HTML <BODY> tag.
+
+=item text_body
+
+Email body (Text alternative).  Arrayref of lines, or scalar.
+
+=back
+
+Returns an argument list to be passsed to L<send_email>.
+
+=cut
+
+#false laziness w/FS::cust_bill::generate_email
+
+use MIME::Entity;
+use HTML::Entities;
+
+sub generate_email {
+  my %args = @_;
+
+  my $me = '[FS::Misc::generate_email]';
+
+  my %return = (
+    'from'    => $args{'from'},
+    'to'      => $args{'to'},
+    'subject' => $args{'subject'},
+  );
+
+  #if (ref($args{'to'}) eq 'ARRAY') {
+  #  $return{'to'} = $args{'to'};
+  #} else {
+  #  $return{'to'} = [ grep { $_ !~ /^(POST|FAX)$/ }
+  #                         $self->cust_main->invoicing_list
+  #                  ];
+  #}
+
+  warn "$me creating HTML/text multipart message"
+    if $DEBUG;
+
+  $return{'nobody'} = 1;
+
+  my $alternative = build MIME::Entity
+    'Type'        => 'multipart/alternative',
+    'Encoding'    => '7bit',
+    'Disposition' => 'inline'
+  ;
+
+  my $data;
+  if ( ref($args{'text_body'}) eq 'ARRAY' ) {
+    $data = $args{'text_body'};
+  } else {
+    $data = [ split(/\n/, $args{'text_body'}) ];
+  }
+
+  $alternative->attach(
+    'Type'        => 'text/plain',
+    #'Encoding'    => 'quoted-printable',
+    'Encoding'    => '7bit',
+    'Data'        => $data,
+    'Disposition' => 'inline',
+  );
+
+  my @html_data;
+  if ( ref($args{'html_body'}) eq 'ARRAY' ) {
+    @html_data = @{ $args{'html_body'} };
+  } else {
+    @html_data = split(/\n/, $args{'html_body'});
+  }
+
+  $alternative->attach(
+    'Type'        => 'text/html',
+    'Encoding'    => 'quoted-printable',
+    'Data'        => [ '<html>',
+                       '  <head>',
+                       '    <title>',
+                       '      '. encode_entities($return{'subject'}), 
+                       '    </title>',
+                       '  </head>',
+                       '  <body bgcolor="#e8e8e8">',
+                       @html_data,
+                       '  </body>',
+                       '</html>',
+                     ],
+    'Disposition' => 'inline',
+    #'Filename'    => 'invoice.pdf',
+  );
+
+  #no other attachment:
+  # multipart/related
+  #   multipart/alternative
+  #     text/plain
+  #     text/html
+
+  $return{'content-type'} = 'multipart/related';
+  $return{'mimeparts'} = [ $alternative ];
+  $return{'type'} = 'multipart/alternative'; #Content-Type of first part...
+  #$return{'disposition'} = 'inline';
+
+  %return;
+
+}
+
 =item send_email OPTION => VALUE ...
 
 Options:
 
-I<from> - (required)
+=over 4
+
+=item from
+
+(required)
+
+=item to
+
+(required) comma-separated scalar or arrayref of recipients
+
+=item subject
+
+(required)
 
-I<to> - (required) comma-separated scalar or arrayref of recipients
+=item content-type
 
-I<subject> - (required)
+(optional) MIME type for the body
 
-I<content-type> - (optional) MIME type for the body
+=item body
 
-I<body> - (required unless I<nobody> is true) arrayref of body text lines
+(required unless I<nobody> is true) arrayref of body text lines
 
-I<mimeparts> - (optional, but required if I<nobody> is true) arrayref of MIME::Entity->build PARAMHASH refs or MIME::Entity objects.  These will be passed as arguments to MIME::Entity->attach().
+=item mimeparts
 
-I<nobody> - (optional) when set true, send_email will ignore the I<body> option and simply construct a message with the given I<mimeparts>.  In this case,
+(optional, but required if I<nobody> is true) arrayref of MIME::Entity->build PARAMHASH refs or MIME::Entity objects.  These will be passed as arguments to MIME::Entity->attach().
+
+=item nobody
+
+(optional) when set true, send_email will ignore the I<body> option and simply construct a message with the given I<mimeparts>.  In this case,
 I<content-type>, if specified, overrides the default "multipart/mixed" for the outermost MIME container.
 
-I<content-encoding> - (optional) when using nobody, optional top-level MIME
+=item content-encoding
+
+(optional) when using nobody, optional top-level MIME
 encoding which, if specified, overrides the default "7bit".
 
-I<type> - (optional) type parameter for multipart/related messages
+=item type
+
+(optional) type parameter for multipart/related messages
+
+=back
 
 =cut
 
 use vars qw( $conf );
 use Date::Format;
 use Mail::Header;
-use Mail::Internet 1.44;
+use Mail::Internet 2.00;
 use MIME::Entity;
 use FS::UID;
 
@@ -193,34 +339,51 @@ sub send_email {
 }
 
 #this kludges a "mysmtpsend" method into Mail::Internet for send_email above
+#now updated for MailTools v2!
 package Mail::Internet;
 
 use Mail::Address;
 use Net::SMTP;
-
-sub Mail::Internet::mysmtpsend {
-    my $src  = shift;
-    my %opt = @_;
-    my $host = $opt{Host};
-    my $envelope = $opt{MailFrom};
-    my $noquit = 0;
-    my $smtp;
-    my @hello = defined $opt{Hello} ? (Hello => $opt{Hello}) : ();
-
-    push(@hello, 'Port', $opt{'Port'})
-       if exists $opt{'Port'};
-
-    push(@hello, 'Debug', $opt{'Debug'})
-       if exists $opt{'Debug'};
-
-    if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP')) {
-       $smtp = $host;
-       $noquit = 1;
+use Net::Domain;
+
+sub Mail::Internet::mysmtpsend($@) {
+    my ($self, %opt) = @_;
+
+    my $host     = $opt{Host};
+    my $envelope = $opt{MailFrom}; # || mailaddress();
+    my $quit     = 1;
+
+    my ($smtp, @hello);
+
+    push @hello, Hello => $opt{Hello}
+        if defined $opt{Hello};
+
+    push @hello, Port => $opt{Port}
+        if exists $opt{Port};
+
+    push @hello, Debug => $opt{Debug}
+        if exists $opt{Debug};
+
+#    if(!defined $host)
+#    {   local $SIG{__DIE__};
+#        my @hosts = qw(mailhost localhost);
+#        unshift @hosts, split /\:/, $ENV{SMTPHOSTS}
+#            if defined $ENV{SMTPHOSTS};
+#
+#        foreach $host (@hosts)
+#        {   $smtp = eval { Net::SMTP->new($host, @hello) };
+#            last if defined $smtp;
+#        }
+#    }
+#    elsif(ref($host) && UNIVERSAL::isa($host,'Net::SMTP'))
+    if(ref($host) && UNIVERSAL::isa($host,'Net::SMTP'))
+    {   $smtp = $host;
+        $quit = 0;
     }
-    else {
-       #local $SIG{__DIE__};
-       #$smtp = eval { Net::SMTP->new($host, @hello) };
-       $smtp = new Net::SMTP $host, @hello;
+    else
+    {   #local $SIG{__DIE__};
+        #$smtp = eval { Net::SMTP->new($host, @hello) };
+        $smtp = Net::SMTP->new($host, @hello);
     }
 
     unless ( defined($smtp) ) {
@@ -229,39 +392,35 @@ sub Mail::Internet::mysmtpsend {
       return "can't connect to $host: $err"
     }
 
-    my $hdr = $src->head->dup;
+    my $head = $self->cleaned_header_dup;
 
-    _prephdr($hdr);
+    $head->delete('Bcc');
 
     # Who is it to
 
-    my @rcpt = map { ref($_) ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
-    @rcpt = map { $hdr->get($_) } qw(To Cc Bcc)
-       unless @rcpt;
-    my @addr = map($_->address, Mail::Address->parse(@rcpt));
+    my @rcpt = map { ref $_ ? @$_ : $_ } grep { defined } @opt{'To','Cc','Bcc'};
+    @rcpt    = map { $head->get($_) } qw(To Cc Bcc)
+        unless @rcpt;
 
+    my @addr = map {$_->address} Mail::Address->parse(@rcpt);
+    #@addr or return ();
     return 'No valid destination addresses found!'
        unless(@addr);
 
-    $hdr->delete('Bcc'); # Remove blind Cc's
-
     # Send it
 
-    #warn "Headers: \n" . join('',@{$hdr->header});
-    #warn "Body: \n" . join('',@{$src->body});
-
-    my $ok = $smtp->mail( $envelope ) &&
-               $smtp->to(@addr) &&
-               $smtp->data(join("", @{$hdr->header},"\n",@{$src->body}));
+    my $ok = $smtp->mail($envelope)
+          && $smtp->to(@addr)
+          && $smtp->data(join("", @{$head->header}, "\n", @{$self->body}));
 
+    #$quit && $smtp->quit;
+    #$ok ? @addr : ();
     if ( $ok ) {
-      $smtp->quit
-          unless $noquit;
+      $quit && $smtp->quit;
       return '';
     } else {
       return $smtp->code. ' '. $smtp->message;
     }
-
 }
 package FS::Misc;
 #eokludge
@@ -308,7 +467,7 @@ sub send_fax {
     unless exists($options{'dialstring'});
 
   if (exists($options{'docdata'}) and ref($options{'docdata'}) eq 'ARRAY') {
-      my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+      my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
       my $fh = new File::Temp(
         TEMPLATE => 'faxdoc.'. $options{'dialstring'} . '.XXXXXXXX',
         DIR      => $dir,
@@ -484,15 +643,10 @@ use String::ShellQuote;
 sub generate_ps {
   my $file = shift;
 
-  my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+  my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
   chdir($dir);
 
-  my $sfile = shell_quote $file;
-
-  system("pslatex $sfile.tex >/dev/null 2>&1") == 0
-    or die "pslatex $file.tex failed; see $file.log for details?\n";
-  system("pslatex $sfile.tex >/dev/null 2>&1") == 0
-    or die "pslatex $file.tex failed; see $file.log for details?\n";
+  _pslatex($file);
 
   system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
     or die "dvips failed";
@@ -524,14 +678,87 @@ sub generate_ps {
 
 }
 
+=item generate_pdf FILENAME
+
+Returns an PDF rendition of the LaTex file, as a scalar.  FILENAME does not
+contain the .tex suffix and is unlinked by this function.
+
+=cut
+
+use String::ShellQuote;
+
+sub generate_pdf {
+  my $file = shift;
+
+  my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
+  chdir($dir);
+
+  #system('pdflatex', "$file.tex");
+  #system('pdflatex', "$file.tex");
+  #! LaTeX Error: Unknown graphics extension: .eps.
+
+  _pslatex($file);
+
+  my $sfile = shell_quote $file;
+
+  #system('dvipdf', "$file.dvi", "$file.pdf" );
+  system(
+    "dvips -q -t letter -f $sfile.dvi ".
+    "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ".
+    "     -c save pop -"
+  ) == 0
+    or die "dvips | gs failed: $!";
+
+  open(PDF, "<$file.pdf")
+    or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
+
+  unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
+
+  my $pdf = '';
+  while (<PDF>) {
+    $pdf .= $_;
+  }
+
+  close PDF;
+
+  return $pdf;
+
+}
+
+sub _pslatex {
+  my $file = shift;
+
+  #my $sfile = shell_quote $file;
+
+  my @cmd = (
+    'latex',
+    '-interaction=batchmode',
+    '\AtBeginDocument{\RequirePackage{pslatex}}',
+    '\def\PSLATEXTMP{\futurelet\PSLATEXTMP\PSLATEXTMPB}',
+    '\def\PSLATEXTMPB{\ifx\PSLATEXTMP\nonstopmode\else\input\fi}',
+    '\PSLATEXTMP',
+    "$file.tex"
+  );
+
+  my $timeout = 30; #? should be more than enough
+
+  for ( 1, 2 ) {
+
+    local($SIG{CHLD}) = sub {};
+    #run( \@cmd, '>'=>'/dev/null', '2>'=>'/dev/null', timeout($timeout) )
+    run( \@cmd, timeout($timeout) )
+      or die "pslatex $file.tex failed; see $file.log for details?\n";
+
+  }
+
+}
+
 =item print ARRAYREF
 
 Sends the lines in ARRAYREF to the printer.
 
 =cut
 
-use IPC::Run3;
-
 sub do_print {
   my $data = shift;