RT#71447: OQM Service label override is not showing when provisioning or viewing...
[freeside.git] / FS / FS / cust_main_Mixin.pm
1 package FS::cust_main_Mixin;
2
3 use strict;
4 use vars qw( $DEBUG $me );
5 use Carp qw( confess carp cluck );
6 use FS::UID qw(dbh);
7 use FS::cust_main;
8 use FS::Record qw( qsearch qsearchs );
9 use FS::Misc qw( send_email generate_email );
10 use HTML::Entities;
11
12 $DEBUG = 0;
13 $me = '[FS::cust_main_Mixin]';
14
15 =head1 NAME
16
17 FS::cust_main_Mixin - Mixin class for records that contain fields from cust_main
18
19 =head1 SYNOPSIS
20
21 package FS::some_table;
22 use vars qw(@ISA);
23 @ISA = qw( FS::cust_main_Mixin FS::Record );
24
25 =head1 DESCRIPTION
26
27 This is a mixin class for records that contain fields from the cust_main table,
28 for example, from a JOINed search.  See httemplate/search/ for examples.
29
30 =head1 METHODS
31
32 =over 4
33
34 =cut
35
36 sub cust_unlinked_msg { '(unlinked)'; }
37 sub cust_linked { $_[0]->custnum; }
38
39 sub cust_main { 
40   my $self = shift;
41   cluck ref($self). '->cust_main called' if $DEBUG;
42   $self->cust_linked ? qsearchs('cust_main', {custnum => $self->custnum}) : '';
43 }
44
45 =item display_custnum
46
47 Given an object that contains fields from cust_main (say, from a JOINed
48 search; see httemplate/search/ for examples), returns the equivalent of the
49 FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
50 a customer.
51
52 =cut
53
54 sub display_custnum {
55   my $self = shift;
56   $self->cust_linked
57     ? FS::cust_main::display_custnum($self)
58     : $self->cust_unlinked_msg;
59 }
60
61 =item name
62
63 Given an object that contains fields from cust_main (say, from a JOINed
64 search; see httemplate/search/ for examples), returns the equivalent of the
65 FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
66 a customer.
67
68 =cut
69
70 sub name {
71   my $self = shift;
72   $self->cust_linked
73     ? FS::cust_main::name($self)
74     : $self->cust_unlinked_msg;
75 }
76
77 =item ship_name
78
79 Given an object that contains fields from cust_main (say, from a JOINed
80 search; see httemplate/search/ for examples), returns the equivalent of the
81 FS::cust_main I<ship_name> method, or "(unlinked)" if this object is not
82 linked to a customer.
83
84 =cut
85
86 sub ship_name {
87   my $self = shift;
88   $self->cust_linked
89     ? FS::cust_main::ship_name($self)
90     : $self->cust_unlinked_msg;
91 }
92
93 =item contact
94
95 Given an object that contains fields from cust_main (say, from a JOINed
96 search; see httemplate/search/ for examples), returns the equivalent of the
97 FS::cust_main I<contact> method, or "(unlinked)" if this object is not linked
98 to a customer.
99
100 =cut
101
102 sub contact {
103   my $self = shift;
104   $self->cust_linked
105     ? FS::cust_main::contact($self)
106     : $self->cust_unlinked_msg;
107 }
108
109 =item ship_contact
110
111 Given an object that contains fields from cust_main (say, from a JOINed
112 search; see httemplate/search/ for examples), returns the equivalent of the
113 FS::cust_main I<ship_contact> method, or "(unlinked)" if this object is not
114 linked to a customer.
115
116 =cut
117
118 sub ship_contact {
119   my $self = shift;
120   $self->cust_linked
121     ? FS::cust_main::ship_contact($self)
122     : $self->cust_unlinked_msg;
123 }
124
125 =item country_full
126
127 Given an object that contains fields from cust_main (say, from a JOINed
128 search; see httemplate/search/ for examples), returns the equivalent of the
129 FS::cust_main I<country_full> method, or "(unlinked)" if this object is not
130 linked to a customer.
131
132 =cut
133
134 sub country_full {
135   my $self = shift;
136   if ( $self->locationnum ) {  # cust_pkg has this
137     my $location = FS::cust_location->by_key($self->locationnum);
138     $location ? $location->country_full : '';
139   } elsif ( $self->cust_linked ) {
140     $self->cust_main->bill_country_full;
141   }
142 }
143
144 =item invoicing_list_emailonly
145
146 Given an object that contains fields from cust_main (say, from a JOINed
147 search; see httemplate/search/ for examples), returns the equivalent of the
148 FS::cust_main I<invoicing_list_emailonly> method, or "(unlinked)" if this
149 object is not linked to a customer.
150
151 =cut
152
153 sub invoicing_list_emailonly {
154   my $self = shift;
155   warn "invoicing_list_email only called on $self, ".
156        "custnum ". $self->custnum. "\n"
157     if $DEBUG;
158   $self->cust_linked
159     ? FS::cust_main::invoicing_list_emailonly($self)
160     : $self->cust_unlinked_msg;
161 }
162
163 =item invoicing_list_emailonly_scalar
164
165 Given an object that contains fields from cust_main (say, from a JOINed
166 search; see httemplate/search/ for examples), returns the equivalent of the
167 FS::cust_main I<invoicing_list_emailonly_scalar> method, or "(unlinked)" if
168 this object is not linked to a customer.
169
170 =cut
171
172 sub invoicing_list_emailonly_scalar {
173   my $self = shift;
174   warn "invoicing_list_emailonly called on $self, ".
175        "custnum ". $self->custnum. "\n"
176     if $DEBUG;
177   $self->cust_linked
178     ? FS::cust_main::invoicing_list_emailonly_scalar($self)
179     : $self->cust_unlinked_msg;
180 }
181
182 =item invoicing_list
183
184 Given an object that contains fields from cust_main (say, from a JOINed
185 search; see httemplate/search/ for examples), returns the equivalent of the
186 FS::cust_main I<invoicing_list> method, or "(unlinked)" if this object is not
187 linked to a customer.
188
189 Note: this method is read-only.
190
191 =cut
192
193 #read-only
194 sub invoicing_list {
195   my $self = shift;
196   $self->cust_linked
197     ? FS::cust_main::invoicing_list($self)
198     : ();
199 }
200
201 =item status
202
203 Given an object that contains fields from cust_main (say, from a JOINed
204 search; see httemplate/search/ for examples), returns the equivalent of the
205 FS::cust_main I<status> method, or "(unlinked)" if this object is not linked to
206 a customer.
207
208 =cut
209
210 sub cust_status {
211   my $self = shift;
212   return $self->cust_unlinked_msg unless $self->cust_linked;
213   my $cust_main = $self->cust_main;
214   return $self->cust_unlinked_msg unless $cust_main;
215   return $cust_main->cust_status;
216 }
217
218 =item ucfirst_cust_status
219
220 Given an object that contains fields from cust_main (say, from a JOINed
221 search; see httemplate/search/ for examples), returns the equivalent of the
222 FS::cust_main I<ucfirst_status> method, or "(unlinked)" if this object is not
223 linked to a customer.
224
225 =cut
226
227 sub ucfirst_cust_status {
228   carp "ucfirst_cust_status deprecated, use cust_status_label";
229   local($FS::cust_main::ucfirst_nowarn) = 1;
230   my $self = shift;
231   $self->cust_linked
232     ? ucfirst( $self->cust_status(@_) ) 
233     : $self->cust_unlinked_msg;
234 }
235
236 =item cust_status_label
237
238 =cut
239
240 sub cust_status_label {
241   my $self = shift;
242
243   $self->cust_linked
244     ? FS::cust_main::cust_status_label($self)
245     : $self->cust_unlinked_msg;
246 }
247
248 =item cust_statuscolor
249
250 Given an object that contains fields from cust_main (say, from a JOINed
251 search; see httemplate/search/ for examples), returns the equivalent of the
252 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
253 a customer.
254
255 =cut
256
257 sub cust_statuscolor {
258   my $self = shift;
259
260   $self->cust_linked
261     ? FS::cust_main::cust_statuscolor($self)
262     : '000000';
263 }
264
265 =item prospect_sql
266
267 =item active_sql
268
269 =item inactive_sql
270
271 =item suspended_sql
272
273 =item cancelled_sql
274
275 Class methods that return SQL framents, equivalent to the corresponding
276 FS::cust_main method.
277
278 =cut
279
280 #      my \$self = shift;
281 #      \$self->cust_linked
282 #        ? FS::cust_main::${sub}_sql(\$self)
283 #        : '0';
284
285 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
286   eval "
287     sub ${sub}_sql {
288       confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
289       'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
290     }
291   ";
292   die $@ if $@;
293 }
294
295 =item cust_search_sql
296
297 Returns a list of SQL WHERE fragments to search for parameters specified
298 in HASHREF.  Valid parameters are:
299
300 =over 4
301
302 =item agentnum
303
304 =item status
305
306 =back
307
308 =cut
309
310 sub cust_search_sql {
311   my($class, $param) = @_;
312
313   if ( $DEBUG ) {
314     warn "$me cust_search_sql called with params: \n".
315          join("\n", map { "  $_: ". $param->{$_} } keys %$param ). "\n";
316   }
317
318   my @search = ();
319
320   if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
321     push @search, "cust_main.agentnum = $1";
322   }
323
324   #status (prospect active inactive suspended cancelled)
325   if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
326     my $method = $param->{'status'}. '_sql';
327     push @search, $class->$method();
328   }
329
330   #here is the agent virtualization
331   push @search,
332     $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
333   
334   return @search;
335
336 }
337
338 =item email_search_result HASHREF
339
340 Emails a notice to the specified customers.  Customers without 
341 invoice email destinations will be skipped.
342
343 Parameters: 
344
345 =over 4
346
347 =item job
348
349 Queue job for status updates.  Required.
350
351 =item search
352
353 Hashref of params to the L<search()> method.  Required.
354
355 =item msgnum
356
357 Message template number (see L<FS::msg_template>).  Overrides all 
358 of the following options.
359
360 =item from
361
362 From: address
363
364 =item subject
365
366 Email Subject:
367
368 =item html_body
369
370 HTML body
371
372 =item text_body
373
374 Text body
375
376 =item to_contact_classnum
377
378 The customer contact class (or classes, as a comma-separated list) to send
379 the message to. If unspecified, will be sent to any contacts that are marked
380 as invoice destinations (the equivalent of specifying 'invoice').
381
382 =back
383
384 Returns an error message, or false for success.
385
386 If any messages fail to send, they will be queued as individual 
387 jobs which can be manually retried.  If the first ten messages 
388 in the job fail, the entire job will abort and return an error.
389
390 =cut
391
392 use Storable qw(thaw);
393 use MIME::Base64;
394 use Data::Dumper qw(Dumper);
395 use Digest::SHA qw(sha1); # for duplicate checking
396
397 sub email_search_result {
398   my($class, $param) = @_;
399
400   my $msgnum = $param->{msgnum};
401   my $from = delete $param->{from};
402   my $subject = delete $param->{subject};
403   my $html_body = delete $param->{html_body};
404   my $text_body = delete $param->{text_body};
405   my $to_contact_classnum = delete $param->{to_contact_classnum};
406   my $error = '';
407
408   my $job = delete $param->{'job'}
409     or die "email_search_result must run from the job queue.\n";
410   
411   my $msg_template;
412   if ( $msgnum ) {
413     $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
414       or die "msgnum $msgnum not found\n";
415   } else {
416     $msg_template = FS::msg_template->new({
417         from_addr => $from,
418         msgname   => $subject, # maybe a timestamp also?
419         disabled  => 'D', # 'D'raft
420         # msgclass, maybe
421     });
422     $error = $msg_template->insert(
423       subject => $subject,
424       body    => $html_body,
425     );
426     return "$error (when creating draft template)" if $error;
427   }
428
429   my $sql_query = $class->search($param->{'search'});
430   $sql_query->{'select'} = $sql_query->{'table'} . '.*';
431
432   my $count_query   = delete($sql_query->{'count_query'});
433   my $count_sth = dbh->prepare($count_query)
434     or die "Error preparing $count_query: ". dbh->errstr;
435   $count_sth->execute
436     or die "Error executing $count_query: ". $count_sth->errstr;
437   my $count_arrayref = $count_sth->fetchrow_arrayref;
438   my $num_cust = $count_arrayref->[0];
439
440   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
441   my @retry_jobs = ();
442   my $dups = 0;
443   my $success = 0;
444   my %sent_to = ();
445
446   if ( !$msg_template ) {
447     die "email_search_result now requires a msg_template";
448   }
449
450   #eventually order+limit magic to reduce memory use?
451   foreach my $obj ( qsearch($sql_query) ) {
452
453     #progressbar first, so that the count is right
454     $num++;
455     if ( time - $min_sec > $last ) {
456       my $error = $job->update_statustext(
457         int( 100 * $num / $num_cust )
458       );
459       die $error if $error;
460       $last = time;
461     }
462
463     my $cust_main = $obj->cust_main;
464     if ( !$cust_main ) { 
465       next; # unlinked object; nothing else we can do
466     }
467
468     my $cust_msg = $msg_template->prepare(
469       'cust_main' => $cust_main,
470       'object'    => $obj,
471       'to_contact_classnum' => $to_contact_classnum,
472     );
473
474     # For non-cust_main searches, we avoid duplicates based on message
475     # body text.
476     my $unique = $cust_main->custnum;
477     $unique .= sha1($cust_msg->text_body) if $class ne 'FS::cust_main';
478     if( $sent_to{$unique} ) {
479       # avoid duplicates
480       $dups++;
481       next;
482     }
483
484     $sent_to{$unique} = 1;
485     
486     $error = $cust_msg->send;
487
488     if($error) {
489       # queue the sending of this message so that the user can see what we
490       # tried to do, and retry if desired
491       # (note the cust_msg itself also now has a status of 'failed'; that's 
492       # fine, as it will get its status reset if we retry the job)
493       my $queue = new FS::queue {
494         'job'        => 'FS::cust_msg::process_send',
495         'custnum'    => $cust_main->custnum,
496         'status'     => 'failed',
497         'statustext' => $error,
498       };
499       $queue->insert($cust_msg->custmsgnum);
500       push @retry_jobs, $queue;
501     }
502     else {
503       $success++;
504     }
505
506     if($success == 0 and
507         (scalar(@retry_jobs) > 10 or $num == $num_cust)
508       ) {
509       # 10 is arbitrary, but if we have enough failures, that's
510       # probably a configuration or network problem, and we
511       # abort the batch and run away screaming.
512       # We NEVER do this if anything was successfully sent.
513       $_->delete foreach (@retry_jobs);
514       return "multiple failures: '$error'\n";
515     }
516   } # foreach $obj
517
518   # if the message template was created as "draft", change its status to
519   # "completed"
520   if ($msg_template->disabled eq 'D') {
521     $msg_template->set('disabled' => 'C');
522     my $error = $msg_template->replace;
523     warn "$error (setting draft message template status)" if $error;
524   }
525
526   if(@retry_jobs) {
527     # fail the job, but with a status message that makes it clear
528     # something was sent.
529     return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
530   }
531
532   return '';
533 }
534
535 sub process_email_search_result {
536   my $job = shift;
537   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
538
539   my $param = shift;
540   warn Dumper($param) if $DEBUG;
541
542   $param->{'job'} = $job;
543
544   $param->{'search'} = thaw(decode_base64($param->{'search'}))
545     or die "process_email_search_result requires search params.\n";
546
547   my $table = $param->{'table'} 
548     or die "process_email_search_result requires table.\n";
549
550   eval "use FS::$table;";
551   die "error loading FS::$table: $@\n" if $@;
552
553   my $error = "FS::$table"->email_search_result( $param );
554   dbh->commit; # save failed jobs before rethrowing the error
555   die $error if $error;
556
557 }
558
559 =item conf
560
561 Returns a configuration handle (L<FS::Conf>) set to the customer's locale, 
562 if they have one.  If not, returns an FS::Conf with no locale.
563
564 =cut
565
566 sub conf {
567   my $self = shift;
568   return $self->{_conf} if (ref $self and $self->{_conf});
569   my $cust_main = $self->cust_main;
570   my $conf = new FS::Conf { 
571     'locale' => ($cust_main ? $cust_main->locale : '')
572   };
573   $self->{_conf} = $conf if ref $self;
574   return $conf;
575 }
576
577 =item mt TEXT [, ARGS ]
578
579 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
580 if they have one.
581
582 =cut
583
584 sub mt {
585   my $self = shift;
586   return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
587   my $cust_main = $self->cust_main;
588   my $locale = $cust_main ? $cust_main->locale : '';
589   my $lh = FS::L10N->get_handle($locale);
590   $self->{_lh} = $lh if ref $self;
591   return $lh->maketext(@_);
592 }
593
594 =item time2str_local FORMAT, TIME[, ESCAPE]
595
596 Localizes a date (see L<Date::Language>) for the customer's locale.
597
598 FORMAT can be a L<Date::Format> string, or one of these special words:
599
600 - "short": the value of the "date_format" config setting for the customer's 
601   locale, defaulting to "%x".
602 - "rdate": the same as "short" except that the default has a four-digit year.
603 - "long": the value of the "date_format_long" config setting for the 
604   customer's locale, defaulting to "%b %o, %Y".
605
606 ESCAPE, if specified, is one of "latex" or "html", and will escape non-ASCII
607 characters and convert spaces to nonbreaking spaces.
608
609 =cut
610
611 sub time2str_local {
612   # renamed so that we don't have to change every single reference to 
613   # time2str everywhere
614   my $self = shift;
615   my ($format, $time, $escape) = @_;
616   return '' unless $time > 0; # work around time2str's traditional stupidity
617
618   $self->{_date_format} ||= {};
619   if (!exists($self->{_dh})) {
620     my $cust_main = $self->cust_main;
621     my $locale = $cust_main->locale  if $cust_main;
622     $locale ||= 'en_US';
623     my %info = FS::Locales->locale_info($locale);
624     my $dh = eval { Date::Language->new($info{'name'}) } ||
625              Date::Language->new(); # fall back to English
626     $self->{_dh} = $dh;
627   }
628
629   if ($format eq 'short') {
630     $format = $self->{_date_format}->{short}
631             ||= $self->conf->config('date_format') || '%x';
632   } elsif ($format eq 'rdate') {
633     $format = $self->{_date_format}->{rdate}
634             ||= $self->conf->config('date_format') || '%m/%d/%Y';
635   } elsif ($format eq 'long') {
636     $format = $self->{_date_format}->{long}
637             ||= $self->conf->config('date_format_long') || '%b %o, %Y';
638   }
639
640   # actually render the date
641   my $string = $self->{_dh}->time2str($format, $time);
642
643   if ($escape) {
644     if ($escape eq 'html') {
645       $string = encode_entities($string);
646       $string =~ s/ +/&nbsp;/g;
647     } elsif ($escape eq 'latex') { # just do nbsp's here
648       $string =~ s/ +/~/g;
649     }
650   }
651   
652   $string;
653 }
654
655 =item unsuspend_balance
656
657 If conf I<unsuspend_balance> is set and customer's current balance is
658 beneath the set threshold, unsuspends customer packages.
659
660 =cut
661
662 sub unsuspend_balance {
663   my $self = shift;
664   my $cust_main = $self->cust_main;
665   my $conf = $self->conf;
666   my $setting = $conf->config('unsuspend_balance') or return;
667   my $maxbalance;
668   if ($setting eq 'Zero') {
669     $maxbalance = 0;
670
671   # kind of a pain to load/check all cust_bill instead of just open ones,
672   # but if for some reason payment gets applied to later bills before
673   # earlier ones, we still want to consider the later ones as allowable balance
674   } elsif ($setting eq 'Latest invoice charges') {
675     my @cust_bill = $cust_main->cust_bill();
676     my $cust_bill = $cust_bill[-1]; #always want the most recent one
677     if ($cust_bill) {
678       $maxbalance = $cust_bill->charged || 0;
679     } else {
680       $maxbalance = 0;
681     }
682   } elsif ($setting eq 'Charges not past due') {
683     my $now = time;
684     $maxbalance = 0;
685     foreach my $cust_bill ($cust_main->cust_bill()) {
686       next unless $now <= ($cust_bill->due_date || $cust_bill->_date);
687       $maxbalance += $cust_bill->charged || 0;
688     }
689   } elsif (length($setting)) {
690     warn "Unrecognized unsuspend_balance setting $setting";
691     return;
692   } else {
693     return;
694   }
695   my $balance = $cust_main->balance || 0;
696   if ($balance <= $maxbalance) {
697     my @errors = $cust_main->unsuspend;
698     # side-fx with nested transactions?  upstack rolls back?
699     warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
700          join(' / ', @errors)
701       if @errors;
702   }
703   return;
704 }
705
706 =back
707
708 =head1 BUGS
709
710 =head1 SEE ALSO
711
712 L<FS::cust_main>, L<FS::Record>
713
714 =cut
715
716 1;
717