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 {
238 carp "ucfirst_cust_status deprecated, use cust_status_label";
239 local($FS::cust_main::ucfirst_nowarn) = 1;
242 ? ucfirst( $self->cust_status(@_) )
243 : $self->cust_unlinked_msg;
246 =item cust_status_label
250 sub cust_status_label {
254 ? FS::cust_main::cust_status_label($self)
255 : $self->cust_unlinked_msg;
258 =item cust_statuscolor
260 Given an object that contains fields from cust_main (say, from a JOINed
261 search; see httemplate/search/ for examples), returns the equivalent of the
262 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
267 sub cust_statuscolor {
271 ? FS::cust_main::cust_statuscolor($self)
285 Class methods that return SQL framents, equivalent to the corresponding
286 FS::cust_main method.
291 # \$self->cust_linked
292 # ? FS::cust_main::${sub}_sql(\$self)
295 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
298 confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
299 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
305 =item cust_search_sql
307 Returns a list of SQL WHERE fragments to search for parameters specified
308 in HASHREF. Valid parameters are:
322 sub cust_search_sql {
323 my($class, $param) = @_;
326 warn "$me cust_search_sql called with params: \n".
327 join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
332 if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
333 push @search, "cust_main.agentnum = $1";
336 #status (prospect active inactive suspended cancelled)
337 if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
338 my $method = $param->{'status'}. '_sql';
339 push @search, $class->$method();
343 my @payby = ref($param->{'payby'})
344 ? @{ $param->{'payby'} }
345 : split(',', $param->{'payby'});
346 @payby = grep /^([A-Z]{4})$/, @payby;
348 push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
351 #here is the agent virtualization
353 $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
359 =item email_search_result HASHREF
361 Emails a notice to the specified customers. Customers without
362 invoice email destinations will be skipped.
370 Queue job for status updates. Required.
374 Hashref of params to the L<search()> method. Required.
378 Message template number (see L<FS::msg_template>). Overrides all
379 of the following options.
399 Returns an error message, or false for success.
401 If any messages fail to send, they will be queued as individual
402 jobs which can be manually retried. If the first ten messages
403 in the job fail, the entire job will abort and return an error.
407 use Storable qw(thaw);
409 use Data::Dumper qw(Dumper);
410 use Digest::SHA qw(sha1); # for duplicate checking
412 sub email_search_result {
413 my($class, $param) = @_;
415 my $msgnum = $param->{msgnum};
416 my $from = delete $param->{from};
417 my $subject = delete $param->{subject};
418 my $html_body = delete $param->{html_body};
419 my $text_body = delete $param->{text_body};
422 my $job = delete $param->{'job'}
423 or die "email_search_result must run from the job queue.\n";
427 $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
428 or die "msgnum $msgnum not found\n";
430 $msg_template = FS::msg_template->new({
432 msgname => $subject, # maybe a timestamp also?
433 disabled => 'D', # 'D'raft
436 $error = $msg_template->insert(
440 return "$error (when creating draft template)" if $error;
443 my $sql_query = $class->search($param->{'search'});
444 $sql_query->{'select'} = $sql_query->{'table'} . '.*';
446 my $count_query = delete($sql_query->{'count_query'});
447 my $count_sth = dbh->prepare($count_query)
448 or die "Error preparing $count_query: ". dbh->errstr;
450 or die "Error executing $count_query: ". $count_sth->errstr;
451 my $count_arrayref = $count_sth->fetchrow_arrayref;
452 my $num_cust = $count_arrayref->[0];
454 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
460 if ( !$msg_template ) {
461 die "email_search_result now requires a msg_template";
464 #eventually order+limit magic to reduce memory use?
465 foreach my $obj ( qsearch($sql_query) ) {
467 #progressbar first, so that the count is right
469 if ( time - $min_sec > $last ) {
470 my $error = $job->update_statustext(
471 int( 100 * $num / $num_cust )
473 die $error if $error;
477 my $cust_main = $obj->cust_main;
479 next; # unlinked object; nothing else we can do
482 my $cust_msg = $msg_template->prepare(
483 'cust_main' => $cust_main,
487 # For non-cust_main searches, we avoid duplicates based on message
489 my $unique = $cust_main->custnum;
490 $unique .= sha1($cust_msg->text_body) if $class ne 'FS::cust_main';
491 if( $sent_to{$unique} ) {
497 $sent_to{$unique} = 1;
499 $error = $cust_msg->send;
502 # queue the sending of this message so that the user can see what we
503 # tried to do, and retry if desired
504 # (note the cust_msg itself also now has a status of 'failed'; that's
505 # fine, as it will get its status reset if we retry the job)
506 my $queue = new FS::queue {
507 'job' => 'FS::cust_msg::process_send',
508 'custnum' => $cust_main->custnum,
509 'status' => 'failed',
510 'statustext' => $error,
512 $queue->insert($cust_msg->custmsgnum);
513 push @retry_jobs, $queue;
520 (scalar(@retry_jobs) > 10 or $num == $num_cust)
522 # 10 is arbitrary, but if we have enough failures, that's
523 # probably a configuration or network problem, and we
524 # abort the batch and run away screaming.
525 # We NEVER do this if anything was successfully sent.
526 $_->delete foreach (@retry_jobs);
527 return "multiple failures: '$error'\n";
531 # if the message template was created as "draft", change its status to
533 if ($msg_template->disabled eq 'D') {
534 $msg_template->set('disabled' => 'C');
535 my $error = $msg_template->replace;
536 warn "$error (setting draft message template status)" if $error;
540 # fail the job, but with a status message that makes it clear
541 # something was sent.
542 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
548 sub process_email_search_result {
550 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
553 warn Dumper($param) if $DEBUG;
555 $param->{'job'} = $job;
557 $param->{'search'} = thaw(decode_base64($param->{'search'}))
558 or die "process_email_search_result requires search params.\n";
560 # $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
561 # unless ref($param->{'payby'});
563 my $table = $param->{'table'}
564 or die "process_email_search_result requires table.\n";
566 eval "use FS::$table;";
567 die "error loading FS::$table: $@\n" if $@;
569 my $error = "FS::$table"->email_search_result( $param );
570 dbh->commit; # save failed jobs before rethrowing the error
571 die $error if $error;
577 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
578 if they have one. If not, returns an FS::Conf with no locale.
584 return $self->{_conf} if (ref $self and $self->{_conf});
585 my $cust_main = $self->cust_main;
586 my $conf = new FS::Conf {
587 'locale' => ($cust_main ? $cust_main->locale : '')
589 $self->{_conf} = $conf if ref $self;
593 =item mt TEXT [, ARGS ]
595 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
602 return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
603 my $cust_main = $self->cust_main;
604 my $locale = $cust_main ? $cust_main->locale : '';
605 my $lh = FS::L10N->get_handle($locale);
606 $self->{_lh} = $lh if ref $self;
607 return $lh->maketext(@_);
610 =item time2str_local FORMAT, TIME[, ESCAPE]
612 Localizes a date (see L<Date::Language>) for the customer's locale.
614 FORMAT can be a L<Date::Format> string, or one of these special words:
616 - "short": the value of the "date_format" config setting for the customer's
617 locale, defaulting to "%x".
618 - "rdate": the same as "short" except that the default has a four-digit year.
619 - "long": the value of the "date_format_long" config setting for the
620 customer's locale, defaulting to "%b %o, %Y".
622 ESCAPE, if specified, is one of "latex" or "html", and will escape non-ASCII
623 characters and convert spaces to nonbreaking spaces.
628 # renamed so that we don't have to change every single reference to
629 # time2str everywhere
631 my ($format, $time, $escape) = @_;
632 return '' unless $time > 0; # work around time2str's traditional stupidity
634 $self->{_date_format} ||= {};
635 if (!exists($self->{_dh})) {
636 my $cust_main = $self->cust_main;
637 my $locale = $cust_main->locale if $cust_main;
639 my %info = FS::Locales->locale_info($locale);
640 my $dh = eval { Date::Language->new($info{'name'}) } ||
641 Date::Language->new(); # fall back to English
645 if ($format eq 'short') {
646 $format = $self->{_date_format}->{short}
647 ||= $self->conf->config('date_format') || '%x';
648 } elsif ($format eq 'rdate') {
649 $format = $self->{_date_format}->{rdate}
650 ||= $self->conf->config('date_format') || '%m/%d/%Y';
651 } elsif ($format eq 'long') {
652 $format = $self->{_date_format}->{long}
653 ||= $self->conf->config('date_format_long') || '%b %o, %Y';
656 # actually render the date
657 my $string = $self->{_dh}->time2str($format, $time);
660 if ($escape eq 'html') {
661 $string = encode_entities($string);
662 $string =~ s/ +/ /g;
663 } elsif ($escape eq 'latex') { # just do nbsp's here
677 L<FS::cust_main>, L<FS::Record>