1 package FS::cust_main_Mixin;
4 use vars qw( $DEBUG $me );
5 use Carp qw( confess );
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 $self->cust_linked ? qsearchs('cust_main', {custnum => $self->custnum}) : '';
46 Given an object that contains fields from cust_main (say, from a JOINed
47 search; see httemplate/search/ for examples), returns the equivalent of the
48 FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
56 ? FS::cust_main::display_custnum($self)
57 : $self->cust_unlinked_msg;
62 Given an object that contains fields from cust_main (say, from a JOINed
63 search; see httemplate/search/ for examples), returns the equivalent of the
64 FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
72 ? FS::cust_main::name($self)
73 : $self->cust_unlinked_msg;
78 Given an object that contains fields from cust_main (say, from a JOINed
79 search; see httemplate/search/ for examples), returns the equivalent of the
80 FS::cust_main I<ship_name> method, or "(unlinked)" if this object is not
88 ? FS::cust_main::ship_name($self)
89 : $self->cust_unlinked_msg;
94 Given an object that contains fields from cust_main (say, from a JOINed
95 search; see httemplate/search/ for examples), returns the equivalent of the
96 FS::cust_main I<contact> method, or "(unlinked)" if this object is not linked
104 ? FS::cust_main::contact($self)
105 : $self->cust_unlinked_msg;
110 Given an object that contains fields from cust_main (say, from a JOINed
111 search; see httemplate/search/ for examples), returns the equivalent of the
112 FS::cust_main I<ship_contact> method, or "(unlinked)" if this object is not
113 linked to a customer.
120 ? FS::cust_main::ship_contact($self)
121 : $self->cust_unlinked_msg;
126 Given an object that contains fields from cust_main (say, from a JOINed
127 search; see httemplate/search/ for examples), returns the equivalent of the
128 FS::cust_main I<country_full> method, or "(unlinked)" if this object is not
129 linked to a customer.
135 if ( $self->locationnum ) { # cust_pkg has this
136 my $location = FS::cust_location->by_key($self->locationnum);
137 $location ? $location->country_full : '';
138 } elsif ( $self->cust_linked ) {
139 $self->cust_main->bill_country_full;
143 =item invoicing_list_emailonly
145 Given an object that contains fields from cust_main (say, from a JOINed
146 search; see httemplate/search/ for examples), returns the equivalent of the
147 FS::cust_main I<invoicing_list_emailonly> method, or "(unlinked)" if this
148 object is not linked to a customer.
152 sub invoicing_list_emailonly {
154 warn "invoicing_list_email only called on $self, ".
155 "custnum ". $self->custnum. "\n"
158 ? FS::cust_main::invoicing_list_emailonly($self)
159 : $self->cust_unlinked_msg;
162 =item invoicing_list_emailonly_scalar
164 Given an object that contains fields from cust_main (say, from a JOINed
165 search; see httemplate/search/ for examples), returns the equivalent of the
166 FS::cust_main I<invoicing_list_emailonly_scalar> method, or "(unlinked)" if
167 this object is not linked to a customer.
171 sub invoicing_list_emailonly_scalar {
173 warn "invoicing_list_emailonly called on $self, ".
174 "custnum ". $self->custnum. "\n"
177 ? FS::cust_main::invoicing_list_emailonly_scalar($self)
178 : $self->cust_unlinked_msg;
183 Given an object that contains fields from cust_main (say, from a JOINed
184 search; see httemplate/search/ for examples), returns the equivalent of the
185 FS::cust_main I<invoicing_list> method, or "(unlinked)" if this object is not
186 linked to a customer.
188 Note: this method is read-only.
196 ? FS::cust_main::invoicing_list($self)
202 Given an object that contains fields from cust_main (say, from a JOINed
203 search; see httemplate/search/ for examples), returns the equivalent of the
204 FS::cust_main I<status> method, or "(unlinked)" if this object is not linked to
211 return $self->cust_unlinked_msg unless $self->cust_linked;
213 #FS::cust_main::status($self)
214 #false laziness w/actual cust_main::status
215 # (make sure FS::cust_main methods are called)
216 for my $status (qw( prospect active inactive suspended cancelled )) {
217 my $method = $status.'_sql';
218 my $sql = FS::cust_main->$method();;
219 my $numnum = ( $sql =~ s/cust_main\.custnum/?/g );
220 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
221 $sth->execute( ($self->custnum) x $numnum )
222 or die "Error executing 'SELECT $sql': ". $sth->errstr;
223 return $status if $sth->fetchrow_arrayref->[0];
227 =item ucfirst_cust_status
229 Given an object that contains fields from cust_main (say, from a JOINed
230 search; see httemplate/search/ for examples), returns the equivalent of the
231 FS::cust_main I<ucfirst_status> method, or "(unlinked)" if this object is not
232 linked to a customer.
236 sub ucfirst_cust_status {
239 ? ucfirst( $self->cust_status(@_) )
240 : $self->cust_unlinked_msg;
243 =item cust_statuscolor
245 Given an object that contains fields from cust_main (say, from a JOINed
246 search; see httemplate/search/ for examples), returns the equivalent of the
247 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
252 sub cust_statuscolor {
256 ? FS::cust_main::cust_statuscolor($self)
270 Class methods that return SQL framents, equivalent to the corresponding
271 FS::cust_main method.
276 # \$self->cust_linked
277 # ? FS::cust_main::${sub}_sql(\$self)
280 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
283 confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
284 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
290 =item cust_search_sql
292 Returns a list of SQL WHERE fragments to search for parameters specified
293 in HASHREF. Valid parameters are:
307 sub cust_search_sql {
308 my($class, $param) = @_;
311 warn "$me cust_search_sql called with params: \n".
312 join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
317 if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
318 push @search, "cust_main.agentnum = $1";
321 #status (prospect active inactive suspended cancelled)
322 if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
323 my $method = $param->{'status'}. '_sql';
324 push @search, $class->$method();
328 my @payby = ref($param->{'payby'})
329 ? @{ $param->{'payby'} }
330 : split(',', $param->{'payby'});
331 @payby = grep /^([A-Z]{4})$/, @payby;
333 push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
336 #here is the agent virtualization
338 $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
344 =item email_search_result HASHREF
346 Emails a notice to the specified customers. Customers without
347 invoice email destinations will be skipped.
355 Queue job for status updates. Required.
359 Hashref of params to the L<search()> method. Required.
363 Message template number (see L<FS::msg_template>). Overrides all
364 of the following options.
384 Returns an error message, or false for success.
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.
392 use Storable qw(thaw);
394 use Data::Dumper qw(Dumper);
395 use Digest::SHA qw(sha1); # for duplicate checking
397 sub email_search_result {
398 my($class, $param) = @_;
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};
407 my $job = delete $param->{'job'}
408 or die "email_search_result must run from the job queue.\n";
412 $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
413 or die "msgnum $msgnum not found\n";
416 my $sql_query = $class->search($param->{'search'});
417 $sql_query->{'select'} = $sql_query->{'table'} . '.*';
419 my $count_query = delete($sql_query->{'count_query'});
420 my $count_sth = dbh->prepare($count_query)
421 or die "Error preparing $count_query: ". dbh->errstr;
423 or die "Error executing $count_query: ". $count_sth->errstr;
424 my $count_arrayref = $count_sth->fetchrow_arrayref;
425 my $num_cust = $count_arrayref->[0];
427 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
433 #eventually order+limit magic to reduce memory use?
434 foreach my $obj ( qsearch($sql_query) ) {
436 #progressbar first, so that the count is right
438 if ( time - $min_sec > $last ) {
439 my $error = $job->update_statustext(
440 int( 100 * $num / $num_cust )
442 die $error if $error;
446 my $cust_main = $obj->cust_main;
447 tie my %message, 'Tie::IxHash';
449 next; # unlinked object; nothing else we can do
452 if ( $msg_template ) {
453 # Now supports other context objects.
454 %message = $msg_template->prepare(
455 'cust_main' => $cust_main,
460 my @to = $cust_main->invoicing_list_emailonly;
466 'subject' => $subject,
467 'html_body' => $html_body,
468 'text_body' => $text_body,
469 'custnum' => $cust_main->custnum,
473 # For non-cust_main searches, we avoid duplicates based on message
475 my $unique = $cust_main->custnum;
476 $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main';
477 if( $sent_to{$unique} ) {
483 $sent_to{$unique} = 1;
485 $error = send_email( generate_email( %message ) );
488 # queue the sending of this message so that the user can see what we
489 # tried to do, and retry if desired
490 my $queue = new FS::queue {
491 'job' => 'FS::Misc::process_send_email',
492 'custnum' => $cust_main->custnum,
493 'status' => 'failed',
494 'statustext' => $error,
496 $queue->insert(%message);
497 push @retry_jobs, $queue;
504 (scalar(@retry_jobs) > 10 or $num == $num_cust)
506 # 10 is arbitrary, but if we have enough failures, that's
507 # probably a configuration or network problem, and we
508 # abort the batch and run away screaming.
509 # We NEVER do this if anything was successfully sent.
510 $_->delete foreach (@retry_jobs);
511 return "multiple failures: '$error'\n";
516 # fail the job, but with a status message that makes it clear
517 # something was sent.
518 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
524 sub process_email_search_result {
526 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
528 my $param = thaw(decode_base64(shift));
529 warn Dumper($param) if $DEBUG;
531 $param->{'job'} = $job;
533 $param->{'search'} = thaw(decode_base64($param->{'search'}))
534 or die "process_email_search_result requires search params.\n";
536 # $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
537 # unless ref($param->{'payby'});
539 my $table = $param->{'table'}
540 or die "process_email_search_result requires table.\n";
542 eval "use FS::$table;";
543 die "error loading FS::$table: $@\n" if $@;
545 my $error = "FS::$table"->email_search_result( $param );
546 dbh->commit; # save failed jobs before rethrowing the error
547 die $error if $error;
553 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
554 if they have one. If not, returns an FS::Conf with no locale.
560 return $self->{_conf} if (ref $self and $self->{_conf});
561 my $cust_main = $self->cust_main;
562 my $conf = new FS::Conf {
563 'locale' => ($cust_main ? $cust_main->locale : '')
565 $self->{_conf} = $conf if ref $self;
569 =item mt TEXT [, ARGS ]
571 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
578 return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
579 my $cust_main = $self->cust_main;
580 my $locale = $cust_main ? $cust_main->locale : '';
581 my $lh = FS::L10N->get_handle($locale);
582 $self->{_lh} = $lh if ref $self;
583 return $lh->maketext(@_);
586 =item time2str_local FORMAT, TIME[, ESCAPE]
588 Localizes a date (see L<Date::Language>) for the customer's locale.
590 FORMAT can be a L<Date::Format> string, or one of these special words:
592 - "short": the value of the "date_format" config setting for the customer's
593 locale, defaulting to "%x".
594 - "rdate": the same as "short" except that the default has a four-digit year.
595 - "long": the value of the "date_format_long" config setting for the
596 customer's locale, defaulting to "%b %o, %Y".
598 ESCAPE, if specified, is one of "latex" or "html", and will escape non-ASCII
599 characters and convert spaces to nonbreaking spaces.
604 # renamed so that we don't have to change every single reference to
605 # time2str everywhere
607 my ($format, $time, $escape) = @_;
608 return '' unless $time > 0; # work around time2str's traditional stupidity
610 $self->{_date_format} ||= {};
611 if (!exists($self->{_dh})) {
612 my $cust_main = $self->cust_main;
613 my $locale = $cust_main->locale if $cust_main;
615 my %info = FS::Locales->locale_info($locale);
616 my $dh = eval { Date::Language->new($info{'name'}) } ||
617 Date::Language->new(); # fall back to English
621 if ($format eq 'short') {
622 $format = $self->{_date_format}->{short}
623 ||= $self->conf->config('date_format') || '%x';
624 } elsif ($format eq 'rdate') {
625 $format = $self->{_date_format}->{rdate}
626 ||= $self->conf->config('date_format') || '%m/%d/%Y';
627 } elsif ($format eq 'long') {
628 $format = $self->{_date_format}->{long}
629 ||= $self->conf->config('date_format_long') || '%b %o, %Y';
632 # actually render the date
633 my $string = $self->{_dh}->time2str($format, $time);
636 if ($escape eq 'html') {
637 $string = encode_entities($string);
638 $string =~ s/ +/ /g;
639 } elsif ($escape eq 'latex') { # just do nbsp's here
653 L<FS::cust_main>, L<FS::Record>