1 package FS::cust_main_Mixin;
4 use vars qw( $DEBUG $me );
5 use Carp qw( confess carp cluck );
8 use FS::Record qw( qsearch qsearchs );
9 use FS::Misc qw( send_email generate_email );
13 $me = '[FS::cust_main_Mixin]';
17 FS::cust_main_Mixin - Mixin class for records that contain fields from cust_main
21 package FS::some_table;
23 @ISA = qw( FS::cust_main_Mixin FS::Record );
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.
36 sub cust_unlinked_msg { '(unlinked)'; }
37 sub cust_linked { $_[0]->custnum; }
41 cluck ref($self). '->cust_main called' if $DEBUG;
42 $self->cust_linked ? qsearchs('cust_main', {custnum => $self->custnum}) : '';
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
57 ? FS::cust_main::display_custnum($self)
58 : $self->cust_unlinked_msg;
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
73 ? FS::cust_main::name($self)
74 : $self->cust_unlinked_msg;
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
89 ? FS::cust_main::ship_name($self)
90 : $self->cust_unlinked_msg;
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
105 ? FS::cust_main::contact($self)
106 : $self->cust_unlinked_msg;
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.
121 ? FS::cust_main::ship_contact($self)
122 : $self->cust_unlinked_msg;
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.
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;
144 =item invoicing_list_emailonly
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.
153 sub invoicing_list_emailonly {
155 warn "invoicing_list_email only called on $self, ".
156 "custnum ". $self->custnum. "\n"
159 ? FS::cust_main::invoicing_list_emailonly($self)
160 : $self->cust_unlinked_msg;
163 =item invoicing_list_emailonly_scalar
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.
172 sub invoicing_list_emailonly_scalar {
174 warn "invoicing_list_emailonly called on $self, ".
175 "custnum ". $self->custnum. "\n"
178 ? FS::cust_main::invoicing_list_emailonly_scalar($self)
179 : $self->cust_unlinked_msg;
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.
189 Note: this method is read-only.
197 ? FS::cust_main::invoicing_list($self)
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
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;
218 =item ucfirst_cust_status
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.
227 sub ucfirst_cust_status {
230 ? ucfirst( $self->cust_status(@_) )
231 : $self->cust_unlinked_msg;
234 =item cust_statuscolor
236 Given an object that contains fields from cust_main (say, from a JOINed
237 search; see httemplate/search/ for examples), returns the equivalent of the
238 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
243 sub cust_statuscolor {
247 ? FS::cust_main::cust_statuscolor($self)
261 Class methods that return SQL framents, equivalent to the corresponding
262 FS::cust_main method.
267 # \$self->cust_linked
268 # ? FS::cust_main::${sub}_sql(\$self)
271 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
274 confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
275 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
281 =item cust_search_sql
283 Returns a list of SQL WHERE fragments to search for parameters specified
284 in HASHREF. Valid parameters are:
298 sub cust_search_sql {
299 my($class, $param) = @_;
302 warn "$me cust_search_sql called with params: \n".
303 join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
308 if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
309 push @search, "cust_main.agentnum = $1";
312 #status (prospect active inactive suspended cancelled)
313 if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
314 my $method = $param->{'status'}. '_sql';
315 push @search, $class->$method();
319 my @payby = ref($param->{'payby'})
320 ? @{ $param->{'payby'} }
321 : split(',', $param->{'payby'});
322 @payby = grep /^([A-Z]{4})$/, @payby;
324 push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
327 #here is the agent virtualization
329 $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
335 =item email_search_result HASHREF
337 Emails a notice to the specified customers. Customers without
338 invoice email destinations will be skipped.
346 Queue job for status updates. Required.
350 Hashref of params to the L<search()> method. Required.
354 Message template number (see L<FS::msg_template>). Overrides all
355 of the following options.
373 =item to_contact_classnum
375 The customer contact class (or classes, as a comma-separated list) to send
376 the message to. If unspecified, will be sent to any contacts that are marked
377 as invoice destinations (the equivalent of specifying 'invoice').
381 Returns an error message, or false for success.
383 If any messages fail to send, they will be queued as individual
384 jobs which can be manually retried. If the first ten messages
385 in the job fail, the entire job will abort and return an error.
389 use Storable qw(thaw);
391 use Data::Dumper qw(Dumper);
392 use Digest::SHA qw(sha1); # for duplicate checking
394 sub email_search_result {
395 my($class, $param) = @_;
397 my $msgnum = $param->{msgnum};
398 my $from = delete $param->{from};
399 my $subject = delete $param->{subject};
400 my $html_body = delete $param->{html_body};
401 my $text_body = delete $param->{text_body};
402 my $to_contact_classnum = delete $param->{to_contact_classnum};
405 my $job = delete $param->{'job'}
406 or die "email_search_result must run from the job queue.\n";
410 $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
411 or die "msgnum $msgnum not found\n";
414 my $sql_query = $class->search($param->{'search'});
415 $sql_query->{'select'} = $sql_query->{'table'} . '.*';
417 my $count_query = delete($sql_query->{'count_query'});
418 my $count_sth = dbh->prepare($count_query)
419 or die "Error preparing $count_query: ". dbh->errstr;
421 or die "Error executing $count_query: ". $count_sth->errstr;
422 my $count_arrayref = $count_sth->fetchrow_arrayref;
423 my $num_cust = $count_arrayref->[0];
425 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
431 #eventually order+limit magic to reduce memory use?
432 foreach my $obj ( qsearch($sql_query) ) {
434 #progressbar first, so that the count is right
436 if ( time - $min_sec > $last ) {
437 my $error = $job->update_statustext(
438 int( 100 * $num / $num_cust )
440 die $error if $error;
444 my $cust_main = $obj->cust_main;
445 tie my %message, 'Tie::IxHash';
447 next; # unlinked object; nothing else we can do
450 if ( $msg_template ) {
451 # Now supports other context objects.
452 %message = $msg_template->prepare(
453 'cust_main' => $cust_main,
455 'to_contact_classnum' => $to_contact_classnum,
459 # 3.x: false laziness with msg_template.pm; on 4.x, all email notices
460 # are generated from templates and this case goes away
462 if ( $to_contact_classnum ) {
463 @classes = ref($to_contact_classnum) ? @$to_contact_classnum : split(',', $to_contact_classnum);
466 @classes = ( 'invoice' );
468 my @to = $cust_main->contact_list_email(@classes);
474 'subject' => $subject,
475 'html_body' => $html_body,
476 'text_body' => $text_body,
477 'custnum' => $cust_main->custnum,
481 # For non-cust_main searches, we avoid duplicates based on message
483 my $unique = $cust_main->custnum;
484 $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main';
485 if( $sent_to{$unique} ) {
491 $sent_to{$unique} = 1;
493 $error = send_email( generate_email( %message ) );
496 # queue the sending of this message so that the user can see what we
497 # tried to do, and retry if desired
498 my $queue = new FS::queue {
499 'job' => 'FS::Misc::process_send_email',
500 'custnum' => $cust_main->custnum,
501 'status' => 'failed',
502 'statustext' => $error,
504 $queue->insert(%message);
505 push @retry_jobs, $queue;
512 (scalar(@retry_jobs) > 10 or $num == $num_cust)
514 # 10 is arbitrary, but if we have enough failures, that's
515 # probably a configuration or network problem, and we
516 # abort the batch and run away screaming.
517 # We NEVER do this if anything was successfully sent.
518 $_->delete foreach (@retry_jobs);
519 return "multiple failures: '$error'\n";
524 # fail the job, but with a status message that makes it clear
525 # something was sent.
526 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
532 sub process_email_search_result {
534 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
536 my $param = thaw(decode_base64(shift));
537 warn Dumper($param) if $DEBUG;
539 $param->{'job'} = $job;
541 $param->{'search'} = thaw(decode_base64($param->{'search'}))
542 or die "process_email_search_result requires search params.\n";
544 # $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
545 # unless ref($param->{'payby'});
547 my $table = $param->{'table'}
548 or die "process_email_search_result requires table.\n";
550 eval "use FS::$table;";
551 die "error loading FS::$table: $@\n" if $@;
553 my $error = "FS::$table"->email_search_result( $param );
554 dbh->commit; # save failed jobs before rethrowing the error
555 die $error if $error;
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.
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 : '')
573 $self->{_conf} = $conf if ref $self;
577 =item mt TEXT [, ARGS ]
579 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
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(@_);
594 =item time2str_local FORMAT, TIME[, ESCAPE]
596 Localizes a date (see L<Date::Language>) for the customer's locale.
598 FORMAT can be a L<Date::Format> string, or one of these special words:
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".
606 ESCAPE, if specified, is one of "latex" or "html", and will escape non-ASCII
607 characters and convert spaces to nonbreaking spaces.
612 # renamed so that we don't have to change every single reference to
613 # time2str everywhere
615 my ($format, $time, $escape) = @_;
616 return '' unless $time > 0; # work around time2str's traditional stupidity
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;
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
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';
640 # actually render the date
641 my $string = $self->{_dh}->time2str($format, $time);
644 if ($escape eq 'html') {
645 $string = encode_entities($string);
646 $string =~ s/ +/ /g;
647 } elsif ($escape eq 'latex') { # just do nbsp's here
655 =item unsuspend_balance
657 If conf I<unsuspend_balance> is set and customer's current balance is
658 beneath the set threshold, unsuspends customer packages.
662 sub unsuspend_balance {
664 my $cust_main = $self->cust_main;
665 my $conf = $self->conf;
666 my $setting = $conf->config('unsuspend_balance');
668 if ($setting eq 'Zero') {
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
678 $maxbalance = $cust_bill->charged || 0;
682 } elsif ($setting eq 'Charges not past due') {
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;
689 } elsif (length($setting)) {
690 warn "Unrecognized unsuspend_balance setting $setting";
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. ": ".
712 L<FS::cust_main>, L<FS::Record>