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";
241 ? ucfirst( $self->cust_status(@_) )
242 : $self->cust_unlinked_msg;
245 =item cust_status_label
249 sub cust_status_label {
253 ? FS::cust_main::cust_status_label($self)
254 : $self->cust_unlinked_msg;
257 =item cust_statuscolor
259 Given an object that contains fields from cust_main (say, from a JOINed
260 search; see httemplate/search/ for examples), returns the equivalent of the
261 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
266 sub cust_statuscolor {
270 ? FS::cust_main::cust_statuscolor($self)
284 Class methods that return SQL framents, equivalent to the corresponding
285 FS::cust_main method.
290 # \$self->cust_linked
291 # ? FS::cust_main::${sub}_sql(\$self)
294 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
297 confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
298 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
304 =item cust_search_sql
306 Returns a list of SQL WHERE fragments to search for parameters specified
307 in HASHREF. Valid parameters are:
321 sub cust_search_sql {
322 my($class, $param) = @_;
325 warn "$me cust_search_sql called with params: \n".
326 join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
331 if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
332 push @search, "cust_main.agentnum = $1";
335 #status (prospect active inactive suspended cancelled)
336 if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
337 my $method = $param->{'status'}. '_sql';
338 push @search, $class->$method();
342 my @payby = ref($param->{'payby'})
343 ? @{ $param->{'payby'} }
344 : split(',', $param->{'payby'});
345 @payby = grep /^([A-Z]{4})$/, @payby;
347 push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
350 #here is the agent virtualization
352 $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
358 =item email_search_result HASHREF
360 Emails a notice to the specified customers. Customers without
361 invoice email destinations will be skipped.
369 Queue job for status updates. Required.
373 Hashref of params to the L<search()> method. Required.
377 Message template number (see L<FS::msg_template>). Overrides all
378 of the following options.
398 Returns an error message, or false for success.
400 If any messages fail to send, they will be queued as individual
401 jobs which can be manually retried. If the first ten messages
402 in the job fail, the entire job will abort and return an error.
406 use Storable qw(thaw);
408 use Data::Dumper qw(Dumper);
409 use Digest::SHA qw(sha1); # for duplicate checking
411 sub email_search_result {
412 my($class, $param) = @_;
414 my $msgnum = $param->{msgnum};
415 my $from = delete $param->{from};
416 my $subject = delete $param->{subject};
417 my $html_body = delete $param->{html_body};
418 my $text_body = delete $param->{text_body};
421 my $job = delete $param->{'job'}
422 or die "email_search_result must run from the job queue.\n";
426 $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
427 or die "msgnum $msgnum not found\n";
430 my $sql_query = $class->search($param->{'search'});
431 $sql_query->{'select'} = $sql_query->{'table'} . '.*';
433 my $count_query = delete($sql_query->{'count_query'});
434 my $count_sth = dbh->prepare($count_query)
435 or die "Error preparing $count_query: ". dbh->errstr;
437 or die "Error executing $count_query: ". $count_sth->errstr;
438 my $count_arrayref = $count_sth->fetchrow_arrayref;
439 my $num_cust = $count_arrayref->[0];
441 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
447 #eventually order+limit magic to reduce memory use?
448 foreach my $obj ( qsearch($sql_query) ) {
450 #progressbar first, so that the count is right
452 if ( time - $min_sec > $last ) {
453 my $error = $job->update_statustext(
454 int( 100 * $num / $num_cust )
456 die $error if $error;
460 my $cust_main = $obj->cust_main;
461 tie my %message, 'Tie::IxHash';
463 next; # unlinked object; nothing else we can do
466 if ( $msg_template ) {
467 # Now supports other context objects.
468 %message = $msg_template->prepare(
469 'cust_main' => $cust_main,
474 my @to = $cust_main->invoicing_list_emailonly;
480 'subject' => $subject,
481 'html_body' => $html_body,
482 'text_body' => $text_body,
483 'custnum' => $cust_main->custnum,
487 # For non-cust_main searches, we avoid duplicates based on message
489 my $unique = $cust_main->custnum;
490 $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main';
491 if( $sent_to{$unique} ) {
497 $sent_to{$unique} = 1;
499 $error = send_email( generate_email( %message ) );
502 # queue the sending of this message so that the user can see what we
503 # tried to do, and retry if desired
504 my $queue = new FS::queue {
505 'job' => 'FS::Misc::process_send_email',
506 'custnum' => $cust_main->custnum,
507 'status' => 'failed',
508 'statustext' => $error,
510 $queue->insert(%message);
511 push @retry_jobs, $queue;
518 (scalar(@retry_jobs) > 10 or $num == $num_cust)
520 # 10 is arbitrary, but if we have enough failures, that's
521 # probably a configuration or network problem, and we
522 # abort the batch and run away screaming.
523 # We NEVER do this if anything was successfully sent.
524 $_->delete foreach (@retry_jobs);
525 return "multiple failures: '$error'\n";
530 # fail the job, but with a status message that makes it clear
531 # something was sent.
532 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
538 sub process_email_search_result {
540 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
543 warn Dumper($param) if $DEBUG;
545 $param->{'job'} = $job;
547 $param->{'search'} = thaw(decode_base64($param->{'search'}))
548 or die "process_email_search_result requires search params.\n";
550 # $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
551 # unless ref($param->{'payby'});
553 my $table = $param->{'table'}
554 or die "process_email_search_result requires table.\n";
556 eval "use FS::$table;";
557 die "error loading FS::$table: $@\n" if $@;
559 my $error = "FS::$table"->email_search_result( $param );
560 dbh->commit; # save failed jobs before rethrowing the error
561 die $error if $error;
567 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
568 if they have one. If not, returns an FS::Conf with no locale.
574 return $self->{_conf} if (ref $self and $self->{_conf});
575 my $cust_main = $self->cust_main;
576 my $conf = new FS::Conf {
577 'locale' => ($cust_main ? $cust_main->locale : '')
579 $self->{_conf} = $conf if ref $self;
583 =item mt TEXT [, ARGS ]
585 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
592 return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
593 my $cust_main = $self->cust_main;
594 my $locale = $cust_main ? $cust_main->locale : '';
595 my $lh = FS::L10N->get_handle($locale);
596 $self->{_lh} = $lh if ref $self;
597 return $lh->maketext(@_);
600 =item time2str_local FORMAT, TIME[, ESCAPE]
602 Localizes a date (see L<Date::Language>) for the customer's locale.
604 FORMAT can be a L<Date::Format> string, or one of these special words:
606 - "short": the value of the "date_format" config setting for the customer's
607 locale, defaulting to "%x".
608 - "rdate": the same as "short" except that the default has a four-digit year.
609 - "long": the value of the "date_format_long" config setting for the
610 customer's locale, defaulting to "%b %o, %Y".
612 ESCAPE, if specified, is one of "latex" or "html", and will escape non-ASCII
613 characters and convert spaces to nonbreaking spaces.
618 # renamed so that we don't have to change every single reference to
619 # time2str everywhere
621 my ($format, $time, $escape) = @_;
622 return '' unless $time > 0; # work around time2str's traditional stupidity
624 $self->{_date_format} ||= {};
625 if (!exists($self->{_dh})) {
626 my $cust_main = $self->cust_main;
627 my $locale = $cust_main->locale if $cust_main;
629 my %info = FS::Locales->locale_info($locale);
630 my $dh = eval { Date::Language->new($info{'name'}) } ||
631 Date::Language->new(); # fall back to English
635 if ($format eq 'short') {
636 $format = $self->{_date_format}->{short}
637 ||= $self->conf->config('date_format') || '%x';
638 } elsif ($format eq 'rdate') {
639 $format = $self->{_date_format}->{rdate}
640 ||= $self->conf->config('date_format') || '%m/%d/%Y';
641 } elsif ($format eq 'long') {
642 $format = $self->{_date_format}->{long}
643 ||= $self->conf->config('date_format_long') || '%b %o, %Y';
646 # actually render the date
647 my $string = $self->{_dh}->time2str($format, $time);
650 if ($escape eq 'html') {
651 $string = encode_entities($string);
652 $string =~ s/ +/ /g;
653 } elsif ($escape eq 'latex') { # just do nbsp's here
667 L<FS::cust_main>, L<FS::Record>