This commit was generated by cvs2svn to compensate for changes in r12472,
[freeside.git] / FS / FS / msg_template.pm
1 package FS::msg_template;
2
3 use strict;
4 use base qw( FS::Record );
5 use Text::Template;
6 use FS::Misc qw( generate_email send_email );
7 use FS::Conf;
8 use FS::Record qw( qsearch qsearchs );
9 use FS::UID qw( dbh );
10
11 use FS::cust_main;
12 use FS::cust_msg;
13 use FS::template_content;
14
15 use Date::Format qw( time2str );
16 use HTML::Entities qw( decode_entities encode_entities ) ;
17 use HTML::FormatText;
18 use HTML::TreeBuilder;
19 use vars qw( $DEBUG $conf );
20
21 FS::UID->install_callback( sub { $conf = new FS::Conf; } );
22
23 $DEBUG=0;
24
25 =head1 NAME
26
27 FS::msg_template - Object methods for msg_template records
28
29 =head1 SYNOPSIS
30
31   use FS::msg_template;
32
33   $record = new FS::msg_template \%hash;
34   $record = new FS::msg_template { 'column' => 'value' };
35
36   $error = $record->insert;
37
38   $error = $new_record->replace($old_record);
39
40   $error = $record->delete;
41
42   $error = $record->check;
43
44 =head1 DESCRIPTION
45
46 An FS::msg_template object represents a customer message template.
47 FS::msg_template inherits from FS::Record.  The following fields are currently
48 supported:
49
50 =over 4
51
52 =item msgnum - primary key
53
54 =item msgname - Name of the template.  This will appear in the user interface;
55 if it needs to be localized for some users, add it to the message catalog.
56
57 =item agentnum - Agent associated with this template.  Can be NULL for a 
58 global template.
59
60 =item mime_type - MIME type.  Defaults to text/html.
61
62 =item from_addr - Source email address.
63
64 =item disabled - disabled ('Y' or NULL).
65
66 =back
67
68 =head1 METHODS
69
70 =over 4
71
72 =item new HASHREF
73
74 Creates a new template.  To add the template to the database, see L<"insert">.
75
76 Note that this stores the hash reference, not a distinct copy of the hash it
77 points to.  You can ask the object for a copy with the I<hash> method.
78
79 =cut
80
81 # the new method can be inherited from FS::Record, if a table method is defined
82
83 sub table { 'msg_template'; }
84
85 =item insert [ CONTENT ]
86
87 Adds this record to the database.  If there is an error, returns the error,
88 otherwise returns false.
89
90 A default (no locale) L<FS::template_content> object will be created.  CONTENT 
91 is an optional hash containing 'subject' and 'body' for this object.
92
93 =cut
94
95 sub insert {
96   my $self = shift;
97   my %content = @_;
98
99   my $oldAutoCommit = $FS::UID::AutoCommit;
100   local $FS::UID::AutoCommit = 0;
101   my $dbh = dbh;
102
103   my $error = $self->SUPER::insert;
104   if ( !$error ) {
105     $content{'msgnum'} = $self->msgnum;
106     $content{'subject'} ||= '';
107     $content{'body'} ||= '';
108     my $template_content = new FS::template_content (\%content);
109     $error = $template_content->insert;
110   }
111
112   if ( $error ) {
113     $dbh->rollback if $oldAutoCommit;
114     return $error;
115   }
116
117   $dbh->commit if $oldAutoCommit;
118   return;
119 }
120
121 =item delete
122
123 Delete this record from the database.
124
125 =cut
126
127 # the delete method can be inherited from FS::Record
128
129 =item replace [ OLD_RECORD ] [ CONTENT ]
130
131 Replaces the OLD_RECORD with this one in the database.  If there is an error,
132 returns the error, otherwise returns false.
133
134 CONTENT is an optional hash containing 'subject', 'body', and 'locale'.  If 
135 supplied, an L<FS::template_content> object will be created (or modified, if 
136 one already exists for this locale).
137
138 =cut
139
140 sub replace {
141   my $self = shift;
142   my $old = ( ref($_[0]) and $_[0]->isa('FS::Record') ) 
143               ? shift
144               : $self->replace_old;
145   my %content = @_;
146   
147   my $oldAutoCommit = $FS::UID::AutoCommit;
148   local $FS::UID::AutoCommit = 0;
149   my $dbh = dbh;
150
151   my $error = $self->SUPER::replace($old);
152
153   if ( !$error and %content ) {
154     $content{'locale'} ||= '';
155     my $new_content = qsearchs('template_content', {
156                         'msgnum' => $self->msgnum,
157                         'locale' => $content{'locale'},
158                       } );
159     if ( $new_content ) {
160       $new_content->subject($content{'subject'});
161       $new_content->body($content{'body'});
162       $error = $new_content->replace;
163     }
164     else {
165       $content{'msgnum'} = $self->msgnum;
166       $new_content = new FS::template_content \%content;
167       $error = $new_content->insert;
168     }
169   }
170
171   if ( $error ) {
172     $dbh->rollback if $oldAutoCommit;
173     return $error;
174   }
175
176   warn "committing FS::msg_template->replace\n" if $DEBUG and $oldAutoCommit;
177   $dbh->commit if $oldAutoCommit;
178   return;
179 }
180     
181
182
183 =item check
184
185 Checks all fields to make sure this is a valid template.  If there is
186 an error, returns the error, otherwise returns false.  Called by the insert
187 and replace methods.
188
189 =cut
190
191 # the check method should currently be supplied - FS::Record contains some
192 # data checking routines
193
194 sub check {
195   my $self = shift;
196
197   my $error = 
198     $self->ut_numbern('msgnum')
199     || $self->ut_text('msgname')
200     || $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
201     || $self->ut_textn('mime_type')
202     || $self->ut_enum('disabled', [ '', 'Y' ] )
203     || $self->ut_textn('from_addr')
204   ;
205   return $error if $error;
206
207   $self->mime_type('text/html') unless $self->mime_type;
208
209   $self->SUPER::check;
210 }
211
212 =item content_locales
213
214 Returns a hashref of the L<FS::template_content> objects attached to 
215 this template, with the locale as key.
216
217 =cut
218
219 sub content_locales {
220   my $self = shift;
221   return $self->{'_content_locales'} ||= +{
222     map { $_->locale , $_ } 
223     qsearch('template_content', { 'msgnum' => $self->msgnum })
224   };
225 }
226
227 =item prepare OPTION => VALUE
228
229 Fills in the template and returns a hash of the 'from' address, 'to' 
230 addresses, subject line, and body.
231
232 Options are passed as a list of name/value pairs:
233
234 =over 4
235
236 =item cust_main
237
238 Customer object (required).
239
240 =item object
241
242 Additional context object (currently, can be a cust_main, cust_pkg, 
243 cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband, 
244 domain) ).  If the object is a svc_*, its cust_pkg will be fetched and 
245 used for substitution.
246
247 As a special case, this may be an arrayref of two objects.  Both 
248 objects will be available for substitution, with their field names 
249 prefixed with 'new_' and 'old_' respectively.  This is used in the 
250 rt_ticket export when exporting "replace" events.
251
252 =item from_config
253
254 Configuration option to use as the source address, based on the customer's 
255 agentnum.  If unspecified (or the named option is empty), 'invoice_from' 
256 will be used.
257
258 The I<from_addr> field in the template takes precedence over this.
259
260 =item to
261
262 Destination address.  The default is to use the customer's 
263 invoicing_list addresses.  Multiple addresses may be comma-separated.
264
265 =item substitutions
266
267 A hash reference of additional substitutions
268
269 =back
270
271 =cut
272
273 sub prepare {
274   my( $self, %opt ) = @_;
275
276   my $cust_main = $opt{'cust_main'};
277   my $object = $opt{'object'};
278
279   # localization
280   my $locale = $cust_main->locale || '';
281   warn "no locale for cust#".$cust_main->custnum."; using default content\n"
282     if $DEBUG and !$locale;
283   my $content = $self->content($cust_main->locale);
284   warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n"
285     if($DEBUG);
286
287   my $subs = $self->substitutions;
288
289   ###
290   # create substitution table
291   ###  
292   my %hash;
293   my @objects = ($cust_main);
294   my @prefixes = ('');
295   my $svc;
296   if( ref $object ) {
297     if( ref($object) eq 'ARRAY' ) {
298       # [new, old], for provisioning tickets
299       push @objects, $object->[0], $object->[1];
300       push @prefixes, 'new_', 'old_';
301       $svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
302     }
303     else {
304       push @objects, $object;
305       push @prefixes, '';
306       $svc = $object if $object->isa('FS::svc_Common');
307     }
308   }
309   if( $svc ) {
310     push @objects, $svc->cust_svc->cust_pkg;
311     push @prefixes, '';
312   }
313
314   foreach my $obj (@objects) {
315     my $prefix = shift @prefixes;
316     foreach my $name (@{ $subs->{$obj->table} }) {
317       if(!ref($name)) {
318         # simple case
319         $hash{$prefix.$name} = $obj->$name();
320       }
321       elsif( ref($name) eq 'ARRAY' ) {
322         # [ foo => sub { ... } ]
323         $hash{$prefix.($name->[0])} = $name->[1]->($obj);
324       }
325       else {
326         warn "bad msg_template substitution: '$name'\n";
327         #skip it?
328       } 
329     } 
330   } 
331
332   if ( $opt{substitutions} ) {
333     $hash{$_} = $opt{substitutions}->{$_} foreach keys %{$opt{substitutions}};
334   }
335
336   $_ = encode_entities($_ || '') foreach values(%hash);
337
338   ###
339   # clean up template
340   ###
341   my $subject_tmpl = new Text::Template (
342     TYPE   => 'STRING',
343     SOURCE => $content->subject,
344   );
345   my $subject = $subject_tmpl->fill_in( HASH => \%hash );
346
347   my $body = $content->body;
348   my ($skin, $guts) = eviscerate($body);
349   @$guts = map { 
350     $_ = decode_entities($_); # turn all punctuation back into itself
351     s/\r//gs;           # remove \r's
352     s/<br[^>]*>/\n/gsi; # and <br /> tags
353     s/<p>/\n/gsi;       # and <p>
354     s/<\/p>//gsi;       # and </p>
355     s/\240/ /gs;        # and &nbsp;
356     $_
357   } @$guts;
358   
359   $body = '{ use Date::Format qw(time2str); "" }';
360   while(@$skin || @$guts) {
361     $body .= shift(@$skin) || '';
362     $body .= shift(@$guts) || '';
363   }
364
365   ###
366   # fill-in
367   ###
368
369   my $body_tmpl = new Text::Template (
370     TYPE          => 'STRING',
371     SOURCE        => $body,
372   );
373
374   $body = $body_tmpl->fill_in( HASH => \%hash );
375
376   ###
377   # and email
378   ###
379
380   my @to;
381   if ( exists($opt{'to'}) ) {
382     @to = split(/\s*,\s*/, $opt{'to'});
383   }
384   else {
385     @to = $cust_main->invoicing_list_emailonly;
386   }
387   # no warning when preparing with no destination
388
389   my $from_addr = $self->from_addr;
390
391   if ( !$from_addr ) {
392     if ( $opt{'from_config'} ) {
393       $from_addr = scalar( $conf->config($opt{'from_config'}, 
394                                          $cust_main->agentnum) );
395     }
396     $from_addr ||= scalar( $conf->config('invoice_from',
397                                          $cust_main->agentnum) );
398   }
399 #  my @cust_msg = ();
400 #  if ( $conf->exists('log_sent_mail') and !$opt{'preview'} ) {
401 #    my $cust_msg = FS::cust_msg->new({
402 #        'custnum' => $cust_main->custnum,
403 #        'msgnum'  => $self->msgnum,
404 #        'status'  => 'prepared',
405 #      });
406 #    $cust_msg->insert;
407 #    @cust_msg = ('cust_msg' => $cust_msg);
408 #  }
409
410   (
411     'custnum' => $cust_main->custnum,
412     'msgnum'  => $self->msgnum,
413     'from' => $from_addr,
414     'to'   => \@to,
415     'bcc'  => $self->bcc_addr || undef,
416     'subject'   => $subject,
417     'html_body' => $body,
418     'text_body' => HTML::FormatText->new(leftmargin => 0, rightmargin => 70
419                     )->format( HTML::TreeBuilder->new_from_content($body) ),
420   );
421
422 }
423
424 =item send OPTION => VALUE
425
426 Fills in the template and sends it to the customer.  Options are as for 
427 'prepare'.
428
429 =cut
430
431 # broken out from prepare() in case we want to queue the sending,
432 # preview it, etc.
433 sub send {
434   my $self = shift;
435   send_email(generate_email($self->prepare(@_)));
436 }
437
438 # helper sub for package dates
439 my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
440
441 # helper sub for usage-related messages
442 my $usage_warning = sub {
443   my $svc = shift;
444   foreach my $col (qw(seconds upbytes downbytes totalbytes)) {
445     my $amount = $svc->$col; next if $amount eq '';
446     my $method = $col.'_threshold';
447     my $threshold = $svc->$method; next if $threshold eq '';
448     return [$col, $amount, $threshold] if $amount <= $threshold;
449     # this only returns the first one that's below threshold, if there are 
450     # several.
451   }
452   return ['', '', ''];
453 };
454
455 #my $conf = new FS::Conf;
456
457 #return contexts and fill-in values
458 # If you add anything, be sure to add a description in 
459 # httemplate/edit/msg_template.html.
460 sub substitutions {
461   { 'cust_main' => [qw(
462       display_custnum agentnum agent_name
463
464       last first company
465       name name_short contact contact_firstlast
466       address1 address2 city county state zip
467       country
468       daytime night fax
469
470       has_ship_address
471       ship_last ship_first ship_company
472       ship_name ship_name_short ship_contact ship_contact_firstlast
473       ship_address1 ship_address2 ship_city ship_county ship_state ship_zip
474       ship_country
475       ship_daytime ship_night ship_fax
476
477       paymask payname paytype payip
478       num_cancelled_pkgs num_ncancelled_pkgs num_pkgs
479       classname categoryname
480       balance
481       credit_limit
482       invoicing_list_emailonly
483       cust_status ucfirst_cust_status cust_statuscolor
484
485       signupdate dundate
486       packages recurdates
487       ),
488       [ expdate           => sub { shift->paydate_epoch } ], #compatibility
489       [ signupdate_ymd    => sub { $ymd->(shift->signupdate) } ],
490       [ dundate_ymd       => sub { $ymd->(shift->dundate) } ],
491       [ paydate_my        => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
492       [ otaker_first      => sub { shift->access_user->first } ],
493       [ otaker_last       => sub { shift->access_user->last } ],
494       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
495       [ company_name      => sub { 
496           $conf->config('company_name', shift->agentnum) 
497         } ],
498       [ company_address   => sub {
499           $conf->config('company_address', shift->agentnum)
500         } ],
501       [ company_phonenum  => sub {
502           $conf->config('company_phonenum', shift->agentnum)
503         } ],
504     ],
505     # next_bill_date
506     'cust_pkg'  => [qw( 
507       pkgnum pkg_label pkg_label_long
508       location_label
509       status statuscolor
510     
511       start_date setup bill last_bill 
512       adjourn susp expire 
513       labels_short
514       ),
515       [ pkg               => sub { shift->part_pkg->pkg } ],
516       [ cancel            => sub { shift->getfield('cancel') } ], # grrr...
517       [ start_ymd         => sub { $ymd->(shift->getfield('start_date')) } ],
518       [ setup_ymd         => sub { $ymd->(shift->getfield('setup')) } ],
519       [ next_bill_ymd     => sub { $ymd->(shift->getfield('bill')) } ],
520       [ last_bill_ymd     => sub { $ymd->(shift->getfield('last_bill')) } ],
521       [ adjourn_ymd       => sub { $ymd->(shift->getfield('adjourn')) } ],
522       [ susp_ymd          => sub { $ymd->(shift->getfield('susp')) } ],
523       [ expire_ymd        => sub { $ymd->(shift->getfield('expire')) } ],
524       [ cancel_ymd        => sub { $ymd->(shift->getfield('cancel')) } ],
525     ],
526     'cust_bill' => [qw(
527       invnum
528       _date
529     )],
530     #XXX not really thinking about cust_bill substitutions quite yet
531     
532     # for welcome and limit warning messages
533     'svc_acct' => [qw(
534       svcnum
535       username
536       domain
537       ),
538       [ password          => sub { shift->getfield('_password') } ],
539       [ column            => sub { &$usage_warning(shift)->[0] } ],
540       [ amount            => sub { &$usage_warning(shift)->[1] } ],
541       [ threshold         => sub { &$usage_warning(shift)->[2] } ],
542     ],
543     'svc_domain' => [qw(
544       svcnum
545       domain
546       ),
547       [ registrar         => sub {
548           my $registrar = qsearchs('registrar', 
549             { registrarnum => shift->registrarnum} );
550           $registrar ? $registrar->registrarname : ''
551         }
552       ],
553       [ catchall          => sub { 
554           my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
555           $svc_acct ? $svc_acct->email : ''
556         }
557       ],
558     ],
559     'svc_phone' => [qw(
560       svcnum
561       phonenum
562       countrycode
563       domain
564       )
565     ],
566     'svc_broadband' => [qw(
567       svcnum
568       speed_up
569       speed_down
570       ip_addr
571       mac_addr
572       )
573     ],
574     # for payment receipts
575     'cust_pay' => [qw(
576       paynum
577       _date
578       ),
579       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
580       # overrides the one in cust_main in cases where a cust_pay is passed
581       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
582       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
583       [ payinfo           => sub { 
584           my $cust_pay = shift;
585           ($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
586             $cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
587         } ],
588     ],
589     # for payment decline messages
590     # try to support all cust_pay fields
591     # 'error' is a special case, it contains the raw error from the gateway
592     'cust_pay_pending' => [qw(
593       _date
594       error
595       ),
596       [ paid              => sub { sprintf("%.2f", shift->paid) } ],
597       [ payby             => sub { FS::payby->shortname(shift->payby) } ],
598       [ date              => sub { time2str("%a %B %o, %Y", shift->_date) } ],
599       [ payinfo           => sub {
600           my $pending = shift;
601           ($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
602             $pending->paymask : $pending->decrypt($pending->payinfo)
603         } ],
604     ],
605   };
606 }
607
608 =item content LOCALE
609
610 Returns the L<FS::template_content> object appropriate to LOCALE, if there 
611 is one.  If not, returns the one with a NULL locale.
612
613 =cut
614
615 sub content {
616   my $self = shift;
617   my $locale = shift;
618   qsearchs('template_content', 
619             { 'msgnum' => $self->msgnum, 'locale' => $locale }) || 
620   qsearchs('template_content',
621             { 'msgnum' => $self->msgnum, 'locale' => '' });
622 }
623
624 =item agent
625
626 Returns the L<FS::agent> object for this template.
627
628 =cut
629
630 sub agent {
631   qsearchs('agent', { 'agentnum' => $_[0]->agentnum });
632 }
633
634 sub _upgrade_data {
635   my ($self, %opts) = @_;
636
637   my @fixes = (
638     [ 'alerter_msgnum',  'alerter_template',   '',               '', '' ],
639     [ 'cancel_msgnum',   'cancelmessage',      'cancelsubject',  '', '' ],
640     [ 'decline_msgnum',  'declinetemplate',    '',               '', '' ],
641     [ 'impending_recur_msgnum', 'impending_recur_template', '',  '', 'impending_recur_bcc' ],
642     [ 'payment_receipt_msgnum', 'payment_receipt_email', '',     '', '' ],
643     [ 'welcome_msgnum',  'welcome_email',      'welcome_email-subject', 'welcome_email-from', '' ],
644     [ 'warning_msgnum',  'warning_email',      'warning_email-subject', 'warning_email-from', '' ],
645   );
646  
647   my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
648   foreach my $agentnum (@agentnums) {
649     foreach (@fixes) {
650       my ($newname, $oldname, $subject, $from, $bcc) = @$_;
651       if ($conf->exists($oldname, $agentnum)) {
652         my $new = new FS::msg_template({
653           'msgname'   => $oldname,
654           'agentnum'  => $agentnum,
655           'from_addr' => ($from && $conf->config($from, $agentnum)) || '',
656           'bcc_addr'  => ($bcc && $conf->config($from, $agentnum)) || '',
657           'subject'   => ($subject && $conf->config($subject, $agentnum)) || '',
658           'mime_type' => 'text/html',
659           'body'      => join('<BR>',$conf->config($oldname, $agentnum)),
660         });
661         my $error = $new->insert;
662         die $error if $error;
663         $conf->set($newname, $new->msgnum, $agentnum);
664         $conf->delete($oldname, $agentnum);
665         $conf->delete($from, $agentnum) if $from;
666         $conf->delete($subject, $agentnum) if $subject;
667       }
668     }
669   }
670   foreach my $msg_template ( qsearch('msg_template', {}) ) {
671     if ( $msg_template->subject || $msg_template->body ) {
672       # create new default content
673       my %content;
674       foreach ('subject','body') {
675         $content{$_} = $msg_template->$_;
676         $msg_template->setfield($_, '');
677       }
678
679       my $error = $msg_template->replace(%content);
680       die $error if $error;
681     }
682   }
683 }
684
685 sub eviscerate {
686   # Every bit as pleasant as it sounds.
687   #
688   # We do this because Text::Template::Preprocess doesn't
689   # actually work.  It runs the entire template through 
690   # the preprocessor, instead of the code segments.  Which 
691   # is a shame, because Text::Template already contains
692   # the code to do this operation.
693   my $body = shift;
694   my (@outside, @inside);
695   my $depth = 0;
696   my $chunk = '';
697   while($body || $chunk) {
698     my ($first, $delim, $rest);
699     # put all leading non-delimiters into $first
700     ($first, $rest) =
701         ($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
702     $chunk .= $first;
703     # put a leading delimiter into $delim if there is one
704     ($delim, $rest) =
705       ($rest =~ /^([{}]?)(.*)$/s);
706
707     if( $delim eq '{' ) {
708       $chunk .= '{';
709       if( $depth == 0 ) {
710         push @outside, $chunk;
711         $chunk = '';
712       }
713       $depth++;
714     }
715     elsif( $delim eq '}' ) {
716       $depth--;
717       if( $depth == 0 ) {
718         push @inside, $chunk;
719         $chunk = '';
720       }
721       $chunk .= '}';
722     }
723     else {
724       # no more delimiters
725       if( $depth == 0 ) {
726         push @outside, $chunk . $rest;
727       } # else ? something wrong
728       last;
729     }
730     $body = $rest;
731   }
732   (\@outside, \@inside);
733 }
734
735 =back
736
737 =head1 BUGS
738
739 =head1 SEE ALSO
740
741 L<FS::Record>, schema.html from the base documentation.
742
743 =cut
744
745 1;
746