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.
136 ? FS::cust_main::country_full($self)
137 : $self->cust_unlinked_msg;
140 =item invoicing_list_emailonly
142 Given an object that contains fields from cust_main (say, from a JOINed
143 search; see httemplate/search/ for examples), returns the equivalent of the
144 FS::cust_main I<invoicing_list_emailonly> method, or "(unlinked)" if this
145 object is not linked to a customer.
149 sub invoicing_list_emailonly {
151 warn "invoicing_list_email only called on $self, ".
152 "custnum ". $self->custnum. "\n"
155 ? FS::cust_main::invoicing_list_emailonly($self)
156 : $self->cust_unlinked_msg;
159 =item invoicing_list_emailonly_scalar
161 Given an object that contains fields from cust_main (say, from a JOINed
162 search; see httemplate/search/ for examples), returns the equivalent of the
163 FS::cust_main I<invoicing_list_emailonly_scalar> method, or "(unlinked)" if
164 this object is not linked to a customer.
168 sub invoicing_list_emailonly_scalar {
170 warn "invoicing_list_emailonly called on $self, ".
171 "custnum ". $self->custnum. "\n"
174 ? FS::cust_main::invoicing_list_emailonly_scalar($self)
175 : $self->cust_unlinked_msg;
180 Given an object that contains fields from cust_main (say, from a JOINed
181 search; see httemplate/search/ for examples), returns the equivalent of the
182 FS::cust_main I<invoicing_list> method, or "(unlinked)" if this object is not
183 linked to a customer.
185 Note: this method is read-only.
193 ? FS::cust_main::invoicing_list($self)
199 Given an object that contains fields from cust_main (say, from a JOINed
200 search; see httemplate/search/ for examples), returns the equivalent of the
201 FS::cust_main I<status> method, or "(unlinked)" if this object is not linked to
208 return $self->cust_unlinked_msg unless $self->cust_linked;
210 #FS::cust_main::status($self)
211 #false laziness w/actual cust_main::status
212 # (make sure FS::cust_main methods are called)
213 for my $status (qw( prospect active inactive suspended cancelled )) {
214 my $method = $status.'_sql';
215 my $sql = FS::cust_main->$method();;
216 my $numnum = ( $sql =~ s/cust_main\.custnum/?/g );
217 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
218 $sth->execute( ($self->custnum) x $numnum )
219 or die "Error executing 'SELECT $sql': ". $sth->errstr;
220 return $status if $sth->fetchrow_arrayref->[0];
224 =item ucfirst_cust_status
226 Given an object that contains fields from cust_main (say, from a JOINed
227 search; see httemplate/search/ for examples), returns the equivalent of the
228 FS::cust_main I<ucfirst_status> method, or "(unlinked)" if this object is not
229 linked to a customer.
233 sub ucfirst_cust_status {
236 ? ucfirst( $self->cust_status(@_) )
237 : $self->cust_unlinked_msg;
240 =item cust_statuscolor
242 Given an object that contains fields from cust_main (say, from a JOINed
243 search; see httemplate/search/ for examples), returns the equivalent of the
244 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
249 sub cust_statuscolor {
253 ? FS::cust_main::cust_statuscolor($self)
267 Class methods that return SQL framents, equivalent to the corresponding
268 FS::cust_main method.
273 # \$self->cust_linked
274 # ? FS::cust_main::${sub}_sql(\$self)
277 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
280 confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
281 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
287 =item cust_search_sql
289 Returns a list of SQL WHERE fragments to search for parameters specified
290 in HASHREF. Valid parameters are:
304 sub cust_search_sql {
305 my($class, $param) = @_;
308 warn "$me cust_search_sql called with params: \n".
309 join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
314 if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
315 push @search, "cust_main.agentnum = $1";
318 #status (prospect active inactive suspended cancelled)
319 if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
320 my $method = $param->{'status'}. '_sql';
321 push @search, $class->$method();
325 my @payby = ref($param->{'payby'})
326 ? @{ $param->{'payby'} }
327 : split(',', $param->{'payby'});
328 @payby = grep /^([A-Z]{4})$/, @payby;
330 push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
333 #here is the agent virtualization
335 $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
341 =item email_search_result HASHREF
343 Emails a notice to the specified customers. Customers without
344 invoice email destinations will be skipped.
352 Queue job for status updates. Required.
356 Hashref of params to the L<search()> method. Required.
360 Message template number (see L<FS::msg_template>). Overrides all
361 of the following options.
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};
404 my $job = delete $param->{'job'}
405 or die "email_search_result must run from the job queue.\n";
409 $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
410 or die "msgnum $msgnum not found\n";
413 my $sql_query = $class->search($param->{'search'});
414 $sql_query->{'select'} = $sql_query->{'table'} . '.*';
416 my $count_query = delete($sql_query->{'count_query'});
417 my $count_sth = dbh->prepare($count_query)
418 or die "Error preparing $count_query: ". dbh->errstr;
420 or die "Error executing $count_query: ". $count_sth->errstr;
421 my $count_arrayref = $count_sth->fetchrow_arrayref;
422 my $num_cust = $count_arrayref->[0];
424 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
430 #eventually order+limit magic to reduce memory use?
431 foreach my $obj ( qsearch($sql_query) ) {
433 #progressbar first, so that the count is right
435 if ( time - $min_sec > $last ) {
436 my $error = $job->update_statustext(
437 int( 100 * $num / $num_cust )
439 die $error if $error;
443 my $cust_main = $obj->cust_main;
444 tie my %message, 'Tie::IxHash';
446 next; # unlinked object; nothing else we can do
449 if ( $msg_template ) {
450 # Now supports other context objects.
451 %message = $msg_template->prepare(
452 'cust_main' => $cust_main,
457 my @to = $cust_main->invoicing_list_emailonly;
463 'subject' => $subject,
464 'html_body' => $html_body,
465 'text_body' => $text_body,
466 'custnum' => $cust_main->custnum,
470 # For non-cust_main searches, we avoid duplicates based on message
472 my $unique = $cust_main->custnum;
473 $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main';
474 if( $sent_to{$unique} ) {
480 $sent_to{$unique} = 1;
482 $error = send_email( generate_email( %message ) );
485 # queue the sending of this message so that the user can see what we
486 # tried to do, and retry if desired
487 my $queue = new FS::queue {
488 'job' => 'FS::Misc::process_send_email',
489 'custnum' => $cust_main->custnum,
490 'status' => 'failed',
491 'statustext' => $error,
493 $queue->insert(%message);
494 push @retry_jobs, $queue;
501 (scalar(@retry_jobs) > 10 or $num == $num_cust)
503 # 10 is arbitrary, but if we have enough failures, that's
504 # probably a configuration or network problem, and we
505 # abort the batch and run away screaming.
506 # We NEVER do this if anything was successfully sent.
507 $_->delete foreach (@retry_jobs);
508 return "multiple failures: '$error'\n";
513 # fail the job, but with a status message that makes it clear
514 # something was sent.
515 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
521 sub process_email_search_result {
523 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
525 my $param = thaw(decode_base64(shift));
526 warn Dumper($param) if $DEBUG;
528 $param->{'job'} = $job;
530 $param->{'search'} = thaw(decode_base64($param->{'search'}))
531 or die "process_email_search_result requires search params.\n";
533 # $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
534 # unless ref($param->{'payby'});
536 my $table = $param->{'table'}
537 or die "process_email_search_result requires table.\n";
539 eval "use FS::$table;";
540 die "error loading FS::$table: $@\n" if $@;
542 my $error = "FS::$table"->email_search_result( $param );
543 die $error if $error;
549 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
550 if they have one. If not, returns an FS::Conf with no locale.
556 return $self->{_conf} if (ref $self and $self->{_conf});
557 my $cust_main = $self->cust_main;
558 my $conf = new FS::Conf {
559 'locale' => ($cust_main ? $cust_main->locale : '')
561 $self->{_conf} = $conf if ref $self;
565 =item mt TEXT [, ARGS ]
567 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
574 return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
575 my $cust_main = $self->cust_main;
576 my $locale = $cust_main ? $cust_main->locale : '';
577 my $lh = FS::L10N->get_handle($locale);
578 $self->{_lh} = $lh if ref $self;
579 return $lh->maketext(@_);
582 =item time2str_local FORMAT, TIME[, ESCAPE]
584 Localizes a date (see L<Date::Language>) for the customer's locale.
586 FORMAT can be a L<Date::Format> string, or one of these special words:
588 - "short": the value of the "date_format" config setting for the customer's
589 locale, defaulting to "%x".
590 - "rdate": the same as "short" except that the default has a four-digit year.
591 - "long": the value of the "date_format_long" config setting for the
592 customer's locale, defaulting to "%b %o, %Y".
594 ESCAPE, if specified, is one of "latex" or "html", and will escape non-ASCII
595 characters and convert spaces to nonbreaking spaces.
600 # renamed so that we don't have to change every single reference to
601 # time2str everywhere
603 my ($format, $time, $escape) = @_;
604 return '' unless $time > 0; # work around time2str's traditional stupidity
606 $self->{_date_format} ||= {};
607 if (!exists($self->{_dh})) {
608 my $cust_main = $self->cust_main;
609 my $locale = $cust_main->locale if $cust_main;
611 my %info = FS::Locales->locale_info($locale);
612 my $dh = eval { Date::Language->new($info{'name'}) } ||
613 Date::Language->new(); # fall back to English
617 if ($format eq 'short') {
618 $format = $self->{_date_format}->{short}
619 ||= $self->conf->config('date_format') || '%x';
620 } elsif ($format eq 'rdate') {
621 $format = $self->{_date_format}->{rdate}
622 ||= $self->conf->config('date_format') || '%m/%d/%Y';
623 } elsif ($format eq 'long') {
624 $format = $self->{_date_format}->{long}
625 ||= $self->conf->config('date_format_long') || '%b %o, %Y';
628 # actually render the date
629 my $string = $self->{_dh}->time2str($format, $time);
632 if ($escape eq 'html') {
633 $string = encode_entities($string);
634 $string =~ s/ +/ /g;
635 } elsif ($escape eq 'latex') { # just do nbsp's here
649 L<FS::cust_main>, L<FS::Record>