finish adding a feature to easily list all email addresses for an agent & send them...
[freeside.git] / FS / FS / Misc.pm
index 6024b83..936f94a 100644 (file)
@@ -5,9 +5,18 @@ 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 states_hash state_label card_types );
+@EXPORT_OK = qw( generate_email send_email send_fax
+                 states_hash counties state_label
+                 card_types
+                 generate_ps generate_pdf do_print
+               );
 
 $DEBUG = 0;
 
@@ -31,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;
 
@@ -186,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) ) {
@@ -222,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
@@ -301,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,
@@ -359,13 +525,12 @@ sub states_hash {
 #     sort
      map { s/[\n\r]//g; $_; }
      map { $_->state; }
-     qsearch({ 
-               'select'    => 'state',
-               'table'     => 'cust_main_county',
-               'hashref'   => { 'country' => $country },
-               'extra_sql' => 'GROUP BY state',
-            })
-  ;
+         qsearch({ 
+                   'select'    => 'state',
+                   'table'     => 'cust_main_county',
+                   'hashref'   => { 'country' => $country },
+                   'extra_sql' => 'GROUP BY state',
+                });
 
   #it could throw a fatal "Invalid country code" error (for example "AX")
   my $subcountry = eval { new Locale::SubCountry($country) }
@@ -378,6 +543,26 @@ sub states_hash {
        @states;
 }
 
+=item counties STATE COUNTRY
+
+Returns a list of counties for this state and country.
+
+=cut
+
+sub counties {
+  my( $state, $country ) = @_;
+
+  sort map { s/[\n\r]//g; $_; }
+       map { $_->county }
+           qsearch({
+             'select'  => 'DISTINCT county',
+             'table'   => 'cust_main_county',
+             'hashref' => { 'state'   => $state,
+                            'country' => $country,
+                          },
+           });
+}
+
 =item state_label STATE COUNTRY_OR_LOCALE_SUBCOUNRY_OBJECT
 
 =cut
@@ -407,17 +592,18 @@ sub state_label {
 
 =item card_types
 
-Returns a hash reference of the accepted credit card types.
+Returns a hash reference of the accepted credit card types.  Keys are shorter
+identifiers and values are the longer strings used by the system (see
+L<Business::CreditCard>).
 
 =cut
 
 #$conf from above
-use Tie::IxHash;
 
 sub card_types {
   my $conf = new FS::Conf;
 
-  tie my %card_types, 'Tie::IxHash',
+  my %card_types = (
     #displayname                    #value (Business::CreditCard)
     "VISA"                       => "VISA card",
     "MasterCard"                 => "MasterCard",
@@ -429,7 +615,7 @@ sub card_types {
     "BankCard"                   => "BankCard",
     "Switch"                     => "Switch",
     "Solo"                       => "Solo",
-  ;
+  );
   my @conf_card_types = grep { ! /^\s*$/ } $conf->config('card-types');
   if ( @conf_card_types ) {
     #perhaps the hash is backwards for this, but this way works better for
@@ -445,6 +631,148 @@ sub card_types {
   \%card_types;
 }
 
+=item generate_ps FILENAME
+
+Returns an postscript 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_ps {
+  my $file = shift;
+
+  my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
+  chdir($dir);
+
+  _pslatex($file);
+
+  system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0
+    or die "dvips failed";
+
+  open(POSTSCRIPT, "<$file.ps")
+    or die "can't open $file.ps: $! (error in LaTeX template?)\n";
+
+  unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
+
+  my $ps = '';
+
+  if ( $conf->exists('lpr-postscript_prefix') ) {
+    my $prefix = $conf->config('lpr-postscript_prefix');
+    $ps .= eval qq("$prefix");
+  }
+
+  while (<POSTSCRIPT>) {
+    $ps .= $_;
+  }
+
+  close POSTSCRIPT;
+
+  if ( $conf->exists('lpr-postscript_suffix') ) {
+    my $suffix = $conf->config('lpr-postscript_suffix');
+    $ps .= eval qq("$suffix");
+  }
+
+  return $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
+
+sub do_print {
+  my $data = shift;
+
+  my $lpr = $conf->config('lpr');
+
+  my $outerr = '';
+  run3 $lpr, $data, \$outerr, \$outerr;
+  if ( $? ) {
+    $outerr = ": $outerr" if length($outerr);
+    die "Error from $lpr (exit status ". ($?>>8). ")$outerr\n";
+  }
+
+}
+
 =back
 
 =head1 BUGS