1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
|
package FS::msg_template;
use strict;
use base qw( FS::Record );
use Text::Template;
use FS::Misc qw( generate_email send_email );
use FS::Conf;
use FS::Record qw( qsearch qsearchs );
use Date::Format qw( time2str );
use HTML::Entities qw( decode_entities encode_entities ) ;
use HTML::FormatText;
use HTML::TreeBuilder;
use vars '$DEBUG';
$DEBUG=0;
=head1 NAME
FS::msg_template - Object methods for msg_template records
=head1 SYNOPSIS
use FS::msg_template;
$record = new FS::msg_template \%hash;
$record = new FS::msg_template { 'column' => 'value' };
$error = $record->insert;
$error = $new_record->replace($old_record);
$error = $record->delete;
$error = $record->check;
=head1 DESCRIPTION
An FS::msg_template object represents a customer message template.
FS::msg_template inherits from FS::Record. The following fields are currently
supported:
=over 4
=item msgnum
primary key
=item msgname
Template name.
=item agentnum
Agent associated with this template. Can be NULL for a global template.
=item mime_type
MIME type. Defaults to text/html.
=item from_addr
Source email address.
=item subject
The message subject line, in L<Text::Template> format.
=item body
The message body, as plain text or HTML, in L<Text::Template> format.
=item disabled
disabled
=back
=head1 METHODS
=over 4
=item new HASHREF
Creates a new template. To add the template to the database, see L<"insert">.
Note that this stores the hash reference, not a distinct copy of the hash it
points to. You can ask the object for a copy with the I<hash> method.
=cut
# the new method can be inherited from FS::Record, if a table method is defined
sub table { 'msg_template'; }
=item insert
Adds this record to the database. If there is an error, returns the error,
otherwise returns false.
=cut
# the insert method can be inherited from FS::Record
=item delete
Delete this record from the database.
=cut
# the delete method can be inherited from FS::Record
=item replace OLD_RECORD
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
=cut
# the replace method can be inherited from FS::Record
=item check
Checks all fields to make sure this is a valid template. If there is
an error, returns the error, otherwise returns false. Called by the insert
and replace methods.
=cut
# the check method should currently be supplied - FS::Record contains some
# data checking routines
sub check {
my $self = shift;
my $error =
$self->ut_numbern('msgnum')
|| $self->ut_text('msgname')
|| $self->ut_foreign_keyn('agentnum', 'agent', 'agentnum')
|| $self->ut_textn('mime_type')
|| $self->ut_anything('subject')
|| $self->ut_anything('body')
|| $self->ut_enum('disabled', [ '', 'Y' ] )
|| $self->ut_textn('from_addr')
;
return $error if $error;
$self->mime_type('text/html') unless $self->mime_type;
$self->SUPER::check;
}
=item prepare OPTION => VALUE
Fills in the template and returns a hash of the 'from' address, 'to'
addresses, subject line, and body.
Options are passed as a list of name/value pairs:
=over 4
=item cust_main
Customer object (required).
=item object
Additional context object (currently, can be a cust_main, cust_pkg,
cust_bill, cust_pay, cust_pay_pending, or svc_(acct, phone, broadband,
domain) ). If the object is a svc_*, its cust_pkg will be fetched and
used for substitution.
As a special case, this may be an arrayref of two objects. Both
objects will be available for substitution, with their field names
prefixed with 'new_' and 'old_' respectively. This is used in the
rt_ticket export when exporting "replace" events.
=item to
Destination address. The default is to use the customer's
invoicing_list addresses.
=back
=cut
sub prepare {
my( $self, %opt ) = @_;
my $cust_main = $opt{'cust_main'};
my $object = $opt{'object'};
warn "preparing template '".$self->msgname."' to cust#".$cust_main->custnum."\n"
if($DEBUG);
my $subs = $self->substitutions;
###
# create substitution table
###
my %hash;
my @objects = ($cust_main);
my @prefixes = ('');
my $svc;
if( ref $object ) {
if( ref($object) eq 'ARRAY' ) {
# [new, old], for provisioning tickets
push @objects, $object->[0], $object->[1];
push @prefixes, 'new_', 'old_';
$svc = $object->[0] if $object->[0]->isa('FS::svc_Common');
}
else {
push @objects, $object;
push @prefixes, '';
$svc = $object if $object->isa('FS::svc_Common');
}
}
if( $svc ) {
push @objects, $svc->cust_svc->cust_pkg;
push @prefixes, '';
}
foreach my $obj (@objects) {
my $prefix = shift @prefixes;
foreach my $name (@{ $subs->{$obj->table} }) {
if(!ref($name)) {
# simple case
$hash{$prefix.$name} = $obj->$name();
}
elsif( ref($name) eq 'ARRAY' ) {
# [ foo => sub { ... } ]
$hash{$prefix.($name->[0])} = $name->[1]->($obj);
}
else {
warn "bad msg_template substitution: '$name'\n";
#skip it?
}
}
}
$_ = encode_entities($_) foreach values(%hash);
###
# clean up template
###
my $subject_tmpl = new Text::Template (
TYPE => 'STRING',
SOURCE => $self->subject,
);
my $subject = $subject_tmpl->fill_in( HASH => \%hash );
my $body = $self->body;
my ($skin, $guts) = eviscerate($body);
@$guts = map {
$_ = decode_entities($_); # turn all punctuation back into itself
s/\r//gs; # remove \r's
s/<br[^>]*>/\n/gsi; # and <br /> tags
s/<p>/\n/gsi; # and <p>
s/<\/p>//gsi; # and </p>
s/\240/ /gs; # and
$_
} @$guts;
$body = '{ use Date::Format qw(time2str); "" }';
while(@$skin || @$guts) {
$body .= shift(@$skin) || '';
$body .= shift(@$guts) || '';
}
###
# fill-in
###
my $body_tmpl = new Text::Template (
TYPE => 'STRING',
SOURCE => $body,
);
$body = $body_tmpl->fill_in( HASH => \%hash );
###
# and email
###
my @to = ($opt{'to'}) || $cust_main->invoicing_list_emailonly;
#warn "prepared msg_template with no email destination (custnum ".
# $cust_main->custnum.")\n"
# if !@to;
# warning is not appropriate now that we use these for tickets
my $conf = new FS::Conf;
(
'from' => $self->from_addr ||
scalar( $conf->config('invoice_from', $cust_main->agentnum) ),
'to' => \@to,
'bcc' => $self->bcc_addr || undef,
'subject' => $subject,
'html_body' => $body,
'text_body' => HTML::FormatText->new(leftmargin => 0, rightmargin => 70
)->format( HTML::TreeBuilder->new_from_content($body) ),
);
}
=item send OPTION => VALUE
Fills in the template and sends it to the customer. Options are as for
'prepare'.
=cut
# broken out from prepare() in case we want to queue the sending,
# preview it, etc.
sub send {
my $self = shift;
send_email(generate_email($self->prepare(@_)));
}
# helper sub for package dates
my $ymd = sub { $_[0] ? time2str('%Y-%m-%d', $_[0]) : '' };
# needed for some things
my $conf = new FS::Conf;
#return contexts and fill-in values
# If you add anything, be sure to add a description in
# httemplate/edit/msg_template.html.
sub substitutions {
{ 'cust_main' => [qw(
display_custnum agentnum agent_name
last first company
name name_short contact contact_firstlast
address1 address2 city county state zip
country
daytime night 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
classname categoryname
balance
credit_limit
invoicing_list_emailonly
cust_status ucfirst_cust_status cust_statuscolor
signupdate dundate
expdate
packages recurdates
),
# expdate is a special case
[ signupdate_ymd => sub { time2str('%Y-%m-%d', shift->signupdate) } ],
[ dundate_ymd => sub { time2str('%Y-%m-%d', shift->dundate) } ],
[ paydate_my => sub { sprintf('%02d/%04d', shift->paydate_monthyear) } ],
[ otaker_first => sub { shift->access_user->first } ],
[ otaker_last => sub { shift->access_user->last } ],
[ payby => sub { FS::payby->shortname(shift->payby) } ],
[ company_name => sub {
$conf->config('company_name', shift->agentnum)
} ],
[ company_address => sub {
$conf->config('company_address', shift->agentnum)
} ],
],
# next_bill_date
'cust_pkg' => [qw(
pkgnum pkg_label pkg_label_long
location_label
status statuscolor
start_date setup bill last_bill
adjourn susp expire
labels_short
),
[ pkg => sub { shift->part_pkg->pkg } ],
[ cancel => sub { shift->getfield('cancel') } ], # grrr...
[ start_ymd => sub { $ymd->(shift->getfield('start_date')) } ],
[ setup_ymd => sub { $ymd->(shift->getfield('setup')) } ],
[ next_bill_ymd => sub { $ymd->(shift->getfield('bill')) } ],
[ last_bill_ymd => sub { $ymd->(shift->getfield('last_bill')) } ],
[ adjourn_ymd => sub { $ymd->(shift->getfield('adjourn')) } ],
[ susp_ymd => sub { $ymd->(shift->getfield('susp')) } ],
[ expire_ymd => sub { $ymd->(shift->getfield('expire')) } ],
[ cancel_ymd => sub { $ymd->(shift->getfield('cancel')) } ],
],
'cust_bill' => [qw(
invnum
_date
)],
#XXX not really thinking about cust_bill substitutions quite yet
# for welcome and limit warning messages
'svc_acct' => [qw(
svcnum
username
domain
),
[ password => sub { shift->getfield('_password') } ],
],
'svc_domain' => [qw(
svcnum
domain
),
[ registrar => sub {
my $registrar = qsearchs('registrar',
{ registrarnum => shift->registrarnum} );
$registrar ? $registrar->registrarname : ''
}
],
[ catchall => sub {
my $svc_acct = qsearchs('svc_acct', { svcnum => shift->catchall });
$svc_acct ? $svc_acct->email : ''
}
],
],
'svc_phone' => [qw(
svcnum
phonenum
countrycode
domain
)
],
'svc_broadband' => [qw(
svcnum
speed_up
speed_down
ip_addr
mac_addr
)
],
# for payment receipts
'cust_pay' => [qw(
paynum
_date
),
[ paid => sub { sprintf("%.2f", shift->paid) } ],
# overrides the one in cust_main in cases where a cust_pay is passed
[ payby => sub { FS::payby->shortname(shift->payby) } ],
[ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
[ payinfo => sub {
my $cust_pay = shift;
($cust_pay->payby eq 'CARD' || $cust_pay->payby eq 'CHEK') ?
$cust_pay->paymask : $cust_pay->decrypt($cust_pay->payinfo)
} ],
],
# for payment decline messages
# try to support all cust_pay fields
# 'error' is a special case, it contains the raw error from the gateway
'cust_pay_pending' => [qw(
_date
error
),
[ paid => sub { sprintf("%.2f", shift->paid) } ],
[ payby => sub { FS::payby->shortname(shift->payby) } ],
[ date => sub { time2str("%a %B %o, %Y", shift->_date) } ],
[ payinfo => sub {
my $pending = shift;
($pending->payby eq 'CARD' || $pending->payby eq 'CHEK') ?
$pending->paymask : $pending->decrypt($pending->payinfo)
} ],
],
};
}
sub _upgrade_data {
my ($self, %opts) = @_;
my @fixes = (
[ 'alerter_msgnum', 'alerter_template', '', '', '' ],
[ 'cancel_msgnum', 'cancelmessage', 'cancelsubject', '', '' ],
[ 'decline_msgnum', 'declinetemplate', '', '', '' ],
[ 'impending_recur_msgnum', 'impending_recur_template', '', '', 'impending_recur_bcc' ],
[ 'payment_receipt_msgnum', 'payment_receipt_email', '', '', '' ],
[ 'welcome_msgnum', 'welcome_email', 'welcome_email-subject', 'welcome_email-from', '' ],
[ 'warning_msgnum', 'warning_email', 'warning_email-subject', 'warning_email-from', '' ],
);
my $conf = new FS::Conf;
my @agentnums = ('', map {$_->agentnum} qsearch('agent', {}));
foreach my $agentnum (@agentnums) {
foreach (@fixes) {
my ($newname, $oldname, $subject, $from, $bcc) = @$_;
if ($conf->exists($oldname, $agentnum)) {
my $new = new FS::msg_template({
'msgname' => $oldname,
'agentnum' => $agentnum,
'from_addr' => ($from && $conf->config($from, $agentnum)) ||
$conf->config('invoice_from', $agentnum),
'bcc_addr' => ($bcc && $conf->config($from, $agentnum)) || '',
'subject' => ($subject && $conf->config($subject, $agentnum)) || '',
'mime_type' => 'text/html',
'body' => join('<BR>',$conf->config($oldname, $agentnum)),
});
my $error = $new->insert;
die $error if $error;
$conf->set($newname, $new->msgnum, $agentnum);
$conf->delete($oldname, $agentnum);
$conf->delete($from, $agentnum) if $from;
$conf->delete($subject, $agentnum) if $subject;
}
}
}
}
sub eviscerate {
# Every bit as pleasant as it sounds.
#
# We do this because Text::Template::Preprocess doesn't
# actually work. It runs the entire template through
# the preprocessor, instead of the code segments. Which
# is a shame, because Text::Template already contains
# the code to do this operation.
my $body = shift;
my (@outside, @inside);
my $depth = 0;
my $chunk = '';
while($body || $chunk) {
my ($first, $delim, $rest);
# put all leading non-delimiters into $first
($first, $rest) =
($body =~ /^((?:\\[{}]|[^{}])*)(.*)$/s);
$chunk .= $first;
# put a leading delimiter into $delim if there is one
($delim, $rest) =
($rest =~ /^([{}]?)(.*)$/s);
if( $delim eq '{' ) {
$chunk .= '{';
if( $depth == 0 ) {
push @outside, $chunk;
$chunk = '';
}
$depth++;
}
elsif( $delim eq '}' ) {
$depth--;
if( $depth == 0 ) {
push @inside, $chunk;
$chunk = '';
}
$chunk .= '}';
}
else {
# no more delimiters
if( $depth == 0 ) {
push @outside, $chunk . $rest;
} # else ? something wrong
last;
}
$body = $rest;
}
(\@outside, \@inside);
}
=back
=head1 BUGS
=head1 SEE ALSO
L<FS::Record>, schema.html from the base documentation.
=cut
1;
|