Merge branch 'patch-8' of https://github.com/gjones2/Freeside (#13854 as this bug...
[freeside.git] / FS / FS / msg_template.pm
index c183477..e38346a 100644 (file)
@@ -16,6 +16,9 @@ use Date::Format qw( time2str );
 use HTML::Entities qw( decode_entities encode_entities ) ;
 use HTML::FormatText;
 use HTML::TreeBuilder;
+
+use File::Temp;
+use IPC::Run qw(run);
 use vars qw( $DEBUG $conf );
 
 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
@@ -262,6 +265,10 @@ The I<from_addr> field in the template takes precedence over this.
 Destination address.  The default is to use the customer's 
 invoicing_list addresses.  Multiple addresses may be comma-separated.
 
+=item substitutions
+
+A hash reference of additional substitutions
+
 =back
 
 =cut
@@ -269,8 +276,8 @@ invoicing_list addresses.  Multiple addresses may be comma-separated.
 sub prepare {
   my( $self, %opt ) = @_;
 
-  my $cust_main = $opt{'cust_main'};
-  my $object = $opt{'object'};
+  my $cust_main = $opt{'cust_main'} or die 'cust_main required';
+  my $object = $opt{'object'} or die 'object required';
 
   # localization
   my $locale = $cust_main->locale || '';
@@ -324,8 +331,12 @@ sub prepare {
       } 
     } 
   } 
-  $_ = encode_entities($_ || '') foreach values(%hash);
 
+  if ( $opt{substitutions} ) {
+    $hash{$_} = $opt{substitutions}->{$_} foreach keys %{$opt{substitutions}};
+  }
+
+  $_ = encode_entities($_ || '') foreach values(%hash);
 
   ###
   # clean up template
@@ -427,9 +438,79 @@ sub send {
   send_email(generate_email($self->prepare(@_)));
 }
 
+=item render OPTION => VALUE ...
+
+Fills in the template and renders it to a PDF document.  Returns the 
+name of the PDF file.
+
+Options are as for 'prepare', but 'from' and 'to' are meaningless.
+
+=cut
+
+# will also have options to set paper size, margins, etc.
+
+sub render {
+  my $self = shift;
+  eval "use PDF::WebKit";
+  die $@ if $@;
+  my %opt = @_;
+  my %hash = $self->prepare(%opt);
+  my $html = $hash{'html_body'};
+
+  my $tmp = 'msg'.$self->msgnum.'-'.time2str('%Y%m%d', time).'-XXXXXXXX';
+  my $dir = "$FS::UID::cache_dir/cache.$FS::UID::datasrc";
+
+  # Graphics/stylesheets should probably go in /var/www on the Freeside 
+  # machine.
+  my $kit = PDF::WebKit->new(\$html); #%options
+  # hack to use our wrapper script
+  $kit->configure(sub { shift->wkhtmltopdf('freeside-wkhtmltopdf') });
+  my $fh = File::Temp->new(
+    TEMPLATE  => $tmp,
+    DIR       => $dir,
+    UNLINK    => 0,
+    SUFFIX    => '.pdf'
+  );
+
+  print $fh $kit->to_pdf;
+  close $fh;
+  return $fh->filename;
+}
+
+=item print OPTIONS
+
+Render a PDF and send it to the printer.  OPTIONS are as for 'render'.
+
+=cut
+
+sub print {
+  my $file = render(@_);
+  my @lpr = $conf->config('lpr');
+  run ([@lpr, '-r'], '<', $file)
+    or die "lpr error:\n$?\n";
+}
+
+
 # helper sub for package dates
 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
 
+# helper sub for money amounts
+my $money = sub { ($conf->money_char || '$') . sprintf('%.2f', $_[0] || 0) };
+
+# helper sub for usage-related messages
+my $usage_warning = sub {
+  my $svc = shift;
+  foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
+    my $amount = $svc->$col; next if $amount eq '';
+    my $method = $col.'_threshold';
+    my $threshold = $svc->$method; next if $threshold eq '';
+    return [$col, $amount, $threshold] if $amount <= $threshold;
+    # this only returns the first one that's below threshold, if there are 
+    # several.
+  }
+  return ['', '', ''];
+};
+
 #my $conf = new FS::Conf;
 
 #return contexts and fill-in values
@@ -443,14 +524,12 @@ sub substitutions {
       name name_short contact contact_firstlast
       address1 address2 city county state zip
       country
-      daytime night fax
+      daytime night mobile fax
 
       has_ship_address
-      ship_last ship_first ship_company
       ship_name ship_name_short ship_contact ship_contact_firstlast
       ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
       ship_country
-      ship_daytime ship_night ship_fax
 
       paymask payname paytype payip
       num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
@@ -463,6 +542,16 @@ sub substitutions {
       signupdate dundate
       packages recurdates
       ),
+      [ invoicing_email => sub { shift->invoicing_list_emailonly_scalar } ],
+      #compatibility: obsolete ship_ fields - use the non-ship versions
+      map (
+        { my $field = $_;
+          [ "ship_$field"   => sub { shift->$field } ]
+        }
+        qw( last first company daytime night fax )
+      ),
+      # ship_name, ship_name_short, ship_contact, ship_contact_firstlast
+      # still work, though
       [ expdate           => sub { shift->paydate_epoch } ], #compatibility
       [ signupdate_ymd    => sub { $ymd->(shift->signupdate) } ],
       [ dundate_ymd       => sub { $ymd->(shift->dundate) } ],
@@ -491,6 +580,8 @@ sub substitutions {
       labels_short
       ),
       [ pkg               => sub { shift->part_pkg->pkg } ],
+      [ pkg_category      => sub { shift->part_pkg->categoryname } ],
+      [ pkg_class         => sub { shift->part_pkg->classname } ],
       [ cancel            => sub { shift->getfield('cancel') } ], # grrr...
       [ start_ymd         => sub { $ymd->(shift->getfield('start_date')) } ],
       [ setup_ymd         => sub { $ymd->(shift->getfield('setup')) } ],
@@ -500,6 +591,13 @@ sub substitutions {
       [ susp_ymd          => sub { $ymd->(shift->getfield('susp')) } ],
       [ expire_ymd        => sub { $ymd->(shift->getfield('expire')) } ],
       [ cancel_ymd        => sub { $ymd->(shift->getfield('cancel')) } ],
+
+      # not necessarily correct for non-flat packages
+      [ setup_fee         => sub { shift->part_pkg->option('setup_fee') } ],
+      [ recur_fee         => sub { shift->part_pkg->option('recur_fee') } ],
+
+      [ freq_pretty       => sub { shift->part_pkg->freq_pretty } ],
+
     ],
     'cust_bill' => [qw(
       invnum
@@ -514,6 +612,9 @@ sub substitutions {
       domain
       ),
       [ password          => sub { shift->getfield('_password') } ],
+      [ column            => sub { &$usage_warning(shift)->[0] } ],
+      [ amount            => sub { &$usage_warning(shift)->[1] } ],
+      [ threshold         => sub { &$usage_warning(shift)->[2] } ],
     ],
     'svc_domain' => [qw(
       svcnum
@@ -627,8 +728,7 @@ sub _upgrade_data {
         my $new = new FS::msg_template({
           'msgname'   => $oldname,
           'agentnum'  => $agentnum,
-          'from_addr' => ($from && $conf->config($from, $agentnum)) || 
-                         $conf->config('invoice_from', $agentnum),
+          'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
           'bcc_addr'  => ($bcc && $conf->config($from, $agentnum)) || '',
           'subject'   => ($subject && $conf->config($subject, $agentnum)) || '',
           'mime_type' => 'text/html',
@@ -647,10 +747,20 @@ sub _upgrade_data {
     if ( $msg_template->subject || $msg_template->body ) {
       # create new default content
       my %content;
-      foreach ('subject','body') {
-        $content{$_} = $msg_template->$_;
-        $msg_template->setfield($_, '');
+      $content{subject} = $msg_template->subject;
+      $msg_template->set('subject', '');
+
+      # work around obscure Pg/DBD bug
+      # https://rt.cpan.org/Public/Bug/Display.html?id=60200
+      # (though the right fix is to upgrade DBD)
+      my $body = $msg_template->body;
+      if ( $body =~ /^x([0-9a-f]+)$/ ) {
+        # there should be no real message templates that look like that
+        warn "converting template body to TEXT\n";
+        $body = pack('H*', $1);
       }
+      $content{body} = $body;
+      $msg_template->set('body', '');
 
       my $error = $msg_template->replace(%content);
       die $error if $error;