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;
214 #FS::cust_main::status($self)
215 #false laziness w/actual cust_main::status
216 # (make sure FS::cust_main methods are called)
217 for my $status (qw( prospect active inactive suspended cancelled )) {
218 my $method = $status.'_sql';
219 my $sql = FS::cust_main->$method();;
220 my $numnum = ( $sql =~ s/cust_main\.custnum/?/g );
221 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
222 $sth->execute( ($self->custnum) x $numnum )
223 or die "Error executing 'SELECT $sql': ". $sth->errstr;
224 return $status if $sth->fetchrow_arrayref->[0];
228 =item ucfirst_cust_status
230 Given an object that contains fields from cust_main (say, from a JOINed
231 search; see httemplate/search/ for examples), returns the equivalent of the
232 FS::cust_main I<ucfirst_status> method, or "(unlinked)" if this object is not
233 linked to a customer.
237 sub ucfirst_cust_status {
240 ? ucfirst( $self->cust_status(@_) )
241 : $self->cust_unlinked_msg;
244 =item cust_statuscolor
246 Given an object that contains fields from cust_main (say, from a JOINed
247 search; see httemplate/search/ for examples), returns the equivalent of the
248 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
253 sub cust_statuscolor {
257 ? FS::cust_main::cust_statuscolor($self)
271 Class methods that return SQL framents, equivalent to the corresponding
272 FS::cust_main method.
277 # \$self->cust_linked
278 # ? FS::cust_main::${sub}_sql(\$self)
281 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
284 confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
285 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
291 =item cust_search_sql
293 Returns a list of SQL WHERE fragments to search for parameters specified
294 in HASHREF. Valid parameters are:
308 sub cust_search_sql {
309 my($class, $param) = @_;
312 warn "$me cust_search_sql called with params: \n".
313 join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
318 if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
319 push @search, "cust_main.agentnum = $1";
322 #status (prospect active inactive suspended cancelled)
323 if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
324 my $method = $param->{'status'}. '_sql';
325 push @search, $class->$method();
329 my @payby = ref($param->{'payby'})
330 ? @{ $param->{'payby'} }
331 : split(',', $param->{'payby'});
332 @payby = grep /^([A-Z]{4})$/, @payby;
334 push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
337 #here is the agent virtualization
339 $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
345 =item email_search_result HASHREF
347 Emails a notice to the specified customers. Customers without
348 invoice email destinations will be skipped.
356 Queue job for status updates. Required.
360 Hashref of params to the L<search()> method. Required.
364 Message template number (see L<FS::msg_template>). Overrides all
365 of the following options.
383 =item to_contact_classnum
385 The customer contact class (or classes, as a comma-separated list) to send
386 the message to. If unspecified, will be sent to any contacts that are marked
387 as invoice destinations (the equivalent of specifying 'invoice').
391 Returns an error message, or false for success.
393 If any messages fail to send, they will be queued as individual
394 jobs which can be manually retried. If the first ten messages
395 in the job fail, the entire job will abort and return an error.
399 use Storable qw(thaw);
401 use Data::Dumper qw(Dumper);
402 use Digest::SHA qw(sha1); # for duplicate checking
404 sub email_search_result {
405 my($class, $param) = @_;
407 my $msgnum = $param->{msgnum};
408 my $from = delete $param->{from};
409 my $subject = delete $param->{subject};
410 my $html_body = delete $param->{html_body};
411 my $text_body = delete $param->{text_body};
412 my $to_contact_classnum = delete $param->{to_contact_classnum};
415 my $job = delete $param->{'job'}
416 or die "email_search_result must run from the job queue.\n";
420 $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
421 or die "msgnum $msgnum not found\n";
424 my $sql_query = $class->search($param->{'search'});
425 $sql_query->{'select'} = $sql_query->{'table'} . '.*';
427 my $count_query = delete($sql_query->{'count_query'});
428 my $count_sth = dbh->prepare($count_query)
429 or die "Error preparing $count_query: ". dbh->errstr;
431 or die "Error executing $count_query: ". $count_sth->errstr;
432 my $count_arrayref = $count_sth->fetchrow_arrayref;
433 my $num_cust = $count_arrayref->[0];
435 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
441 #eventually order+limit magic to reduce memory use?
442 foreach my $obj ( qsearch($sql_query) ) {
444 #progressbar first, so that the count is right
446 if ( time - $min_sec > $last ) {
447 my $error = $job->update_statustext(
448 int( 100 * $num / $num_cust )
450 die $error if $error;
454 my $cust_main = $obj->cust_main;
455 tie my %message, 'Tie::IxHash';
457 next; # unlinked object; nothing else we can do
460 if ( $msg_template ) {
461 # Now supports other context objects.
462 %message = $msg_template->prepare(
463 'cust_main' => $cust_main,
465 'to_contact_classnum' => $to_contact_classnum,
469 # 3.x: false laziness with msg_template.pm; on 4.x, all email notices
470 # are generated from templates and this case goes away
472 if ( $to_contact_classnum ) {
473 @classes = ref($to_contact_classnum) ? @$to_contact_classnum : split(',', $to_contact_classnum);
476 @classes = ( 'invoice' );
478 my @to = $cust_main->contact_list_email(@classes);
484 'subject' => $subject,
485 'html_body' => $html_body,
486 'text_body' => $text_body,
487 'custnum' => $cust_main->custnum,
491 # For non-cust_main searches, we avoid duplicates based on message
493 my $unique = $cust_main->custnum;
494 $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main';
495 if( $sent_to{$unique} ) {
501 $sent_to{$unique} = 1;
503 $error = send_email( generate_email( %message ) );
506 # queue the sending of this message so that the user can see what we
507 # tried to do, and retry if desired
508 my $queue = new FS::queue {
509 'job' => 'FS::Misc::process_send_email',
510 'custnum' => $cust_main->custnum,
511 'status' => 'failed',
512 'statustext' => $error,
514 $queue->insert(%message);
515 push @retry_jobs, $queue;
522 (scalar(@retry_jobs) > 10 or $num == $num_cust)
524 # 10 is arbitrary, but if we have enough failures, that's
525 # probably a configuration or network problem, and we
526 # abort the batch and run away screaming.
527 # We NEVER do this if anything was successfully sent.
528 $_->delete foreach (@retry_jobs);
529 return "multiple failures: '$error'\n";
534 # fail the job, but with a status message that makes it clear
535 # something was sent.
536 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
542 sub process_email_search_result {
544 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
546 my $param = thaw(decode_base64(shift));
547 warn Dumper($param) if $DEBUG;
549 $param->{'job'} = $job;
551 $param->{'search'} = thaw(decode_base64($param->{'search'}))
552 or die "process_email_search_result requires search params.\n";
554 # $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
555 # unless ref($param->{'payby'});
557 my $table = $param->{'table'}
558 or die "process_email_search_result requires table.\n";
560 eval "use FS::$table;";
561 die "error loading FS::$table: $@\n" if $@;
563 my $error = "FS::$table"->email_search_result( $param );
564 dbh->commit; # save failed jobs before rethrowing the error
565 die $error if $error;
571 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
572 if they have one. If not, returns an FS::Conf with no locale.
578 return $self->{_conf} if (ref $self and $self->{_conf});
579 my $cust_main = $self->cust_main;
580 my $conf = new FS::Conf {
581 'locale' => ($cust_main ? $cust_main->locale : '')
583 $self->{_conf} = $conf if ref $self;
587 =item mt TEXT [, ARGS ]
589 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
596 return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
597 my $cust_main = $self->cust_main;
598 my $locale = $cust_main ? $cust_main->locale : '';
599 my $lh = FS::L10N->get_handle($locale);
600 $self->{_lh} = $lh if ref $self;
601 return $lh->maketext(@_);
604 =item time2str_local FORMAT, TIME[, ESCAPE]
606 Localizes a date (see L<Date::Language>) for the customer's locale.
608 FORMAT can be a L<Date::Format> string, or one of these special words:
610 - "short": the value of the "date_format" config setting for the customer's
611 locale, defaulting to "%x".
612 - "rdate": the same as "short" except that the default has a four-digit year.
613 - "long": the value of the "date_format_long" config setting for the
614 customer's locale, defaulting to "%b %o, %Y".
616 ESCAPE, if specified, is one of "latex" or "html", and will escape non-ASCII
617 characters and convert spaces to nonbreaking spaces.
622 # renamed so that we don't have to change every single reference to
623 # time2str everywhere
625 my ($format, $time, $escape) = @_;
626 return '' unless $time > 0; # work around time2str's traditional stupidity
628 $self->{_date_format} ||= {};
629 if (!exists($self->{_dh})) {
630 my $cust_main = $self->cust_main;
631 my $locale = $cust_main->locale if $cust_main;
633 my %info = FS::Locales->locale_info($locale);
634 my $dh = eval { Date::Language->new($info{'name'}) } ||
635 Date::Language->new(); # fall back to English
639 if ($format eq 'short') {
640 $format = $self->{_date_format}->{short}
641 ||= $self->conf->config('date_format') || '%x';
642 } elsif ($format eq 'rdate') {
643 $format = $self->{_date_format}->{rdate}
644 ||= $self->conf->config('date_format') || '%m/%d/%Y';
645 } elsif ($format eq 'long') {
646 $format = $self->{_date_format}->{long}
647 ||= $self->conf->config('date_format_long') || '%b %o, %Y';
650 # actually render the date
651 my $string = $self->{_dh}->time2str($format, $time);
654 if ($escape eq 'html') {
655 $string = encode_entities($string);
656 $string =~ s/ +/ /g;
657 } elsif ($escape eq 'latex') { # just do nbsp's here
665 =item unsuspend_balance
667 If conf I<unsuspend_balance> is set and customer's current balance is
668 beneath the set threshold, unsuspends customer packages.
672 sub unsuspend_balance {
674 my $cust_main = $self->cust_main;
675 my $conf = $self->conf;
676 my $setting = $conf->config('unsuspend_balance');
678 if ($setting eq 'Zero') {
681 # kind of a pain to load/check all cust_bill instead of just open ones,
682 # but if for some reason payment gets applied to later bills before
683 # earlier ones, we still want to consider the later ones as allowable balance
684 } elsif ($setting eq 'Latest invoice charges') {
685 my @cust_bill = $cust_main->cust_bill();
686 my $cust_bill = $cust_bill[-1]; #always want the most recent one
688 $maxbalance = $cust_bill->charged || 0;
692 } elsif ($setting eq 'Charges not past due') {
695 foreach my $cust_bill ($cust_main->cust_bill()) {
696 next unless $now <= ($cust_bill->due_date || $cust_bill->_date);
697 $maxbalance += $cust_bill->charged || 0;
699 } elsif (length($setting)) {
700 warn "Unrecognized unsuspend_balance setting $setting";
705 my $balance = $cust_main->balance || 0;
706 if ($balance <= $maxbalance) {
707 my @errors = $cust_main->unsuspend;
708 # side-fx with nested transactions? upstack rolls back?
709 warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
722 L<FS::cust_main>, L<FS::Record>