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 );
12 $me = '[FS::cust_main_Mixin]';
16 FS::cust_main_Mixin - Mixin class for records that contain fields from cust_main
20 package FS::some_table;
22 @ISA = qw( FS::cust_main_Mixin FS::Record );
26 This is a mixin class for records that contain fields from the cust_main table,
27 for example, from a JOINed search. See httemplate/search/ for examples.
35 sub cust_unlinked_msg { '(unlinked)'; }
36 sub cust_linked { $_[0]->custnum; }
40 $self->cust_linked ? qsearchs('cust_main', {custnum => $self->custnum}) : '';
45 Given an object that contains fields from cust_main (say, from a JOINed
46 search; see httemplate/search/ for examples), returns the equivalent of the
47 FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
55 ? FS::cust_main::display_custnum($self)
56 : $self->cust_unlinked_msg;
61 Given an object that contains fields from cust_main (say, from a JOINed
62 search; see httemplate/search/ for examples), returns the equivalent of the
63 FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
71 ? FS::cust_main::name($self)
72 : $self->cust_unlinked_msg;
77 Given an object that contains fields from cust_main (say, from a JOINed
78 search; see httemplate/search/ for examples), returns the equivalent of the
79 FS::cust_main I<ship_name> method, or "(unlinked)" if this object is not
87 ? FS::cust_main::ship_name($self)
88 : $self->cust_unlinked_msg;
93 Given an object that contains fields from cust_main (say, from a JOINed
94 search; see httemplate/search/ for examples), returns the equivalent of the
95 FS::cust_main I<contact> method, or "(unlinked)" if this object is not linked
103 ? FS::cust_main::contact($self)
104 : $self->cust_unlinked_msg;
109 Given an object that contains fields from cust_main (say, from a JOINed
110 search; see httemplate/search/ for examples), returns the equivalent of the
111 FS::cust_main I<ship_contact> method, or "(unlinked)" if this object is not
112 linked to a customer.
119 ? FS::cust_main::ship_contact($self)
120 : $self->cust_unlinked_msg;
125 Given an object that contains fields from cust_main (say, from a JOINed
126 search; see httemplate/search/ for examples), returns the equivalent of the
127 FS::cust_main I<country_full> method, or "(unlinked)" if this object is not
128 linked to a customer.
135 ? FS::cust_main::country_full($self)
136 : $self->cust_unlinked_msg;
139 =item invoicing_list_emailonly
141 Given an object that contains fields from cust_main (say, from a JOINed
142 search; see httemplate/search/ for examples), returns the equivalent of the
143 FS::cust_main I<invoicing_list_emailonly> method, or "(unlinked)" if this
144 object is not linked to a customer.
148 sub invoicing_list_emailonly {
150 warn "invoicing_list_email only called on $self, ".
151 "custnum ". $self->custnum. "\n"
154 ? FS::cust_main::invoicing_list_emailonly($self)
155 : $self->cust_unlinked_msg;
158 =item invoicing_list_emailonly_scalar
160 Given an object that contains fields from cust_main (say, from a JOINed
161 search; see httemplate/search/ for examples), returns the equivalent of the
162 FS::cust_main I<invoicing_list_emailonly_scalar> method, or "(unlinked)" if
163 this object is not linked to a customer.
167 sub invoicing_list_emailonly_scalar {
169 warn "invoicing_list_emailonly called on $self, ".
170 "custnum ". $self->custnum. "\n"
173 ? FS::cust_main::invoicing_list_emailonly_scalar($self)
174 : $self->cust_unlinked_msg;
179 Given an object that contains fields from cust_main (say, from a JOINed
180 search; see httemplate/search/ for examples), returns the equivalent of the
181 FS::cust_main I<invoicing_list> method, or "(unlinked)" if this object is not
182 linked to a customer.
184 Note: this method is read-only.
192 ? FS::cust_main::invoicing_list($self)
198 Given an object that contains fields from cust_main (say, from a JOINed
199 search; see httemplate/search/ for examples), returns the equivalent of the
200 FS::cust_main I<status> method, or "(unlinked)" if this object is not linked to
207 return $self->cust_unlinked_msg unless $self->cust_linked;
209 #FS::cust_main::status($self)
210 #false laziness w/actual cust_main::status
211 # (make sure FS::cust_main methods are called)
212 for my $status (qw( prospect active inactive suspended cancelled )) {
213 my $method = $status.'_sql';
214 my $sql = FS::cust_main->$method();;
215 my $numnum = ( $sql =~ s/cust_main\.custnum/?/g );
216 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
217 $sth->execute( ($self->custnum) x $numnum )
218 or die "Error executing 'SELECT $sql': ". $sth->errstr;
219 return $status if $sth->fetchrow_arrayref->[0];
223 =item ucfirst_cust_status
225 Given an object that contains fields from cust_main (say, from a JOINed
226 search; see httemplate/search/ for examples), returns the equivalent of the
227 FS::cust_main I<ucfirst_status> method, or "(unlinked)" if this object is not
228 linked to a customer.
232 sub ucfirst_cust_status {
235 ? ucfirst( $self->cust_status(@_) )
236 : $self->cust_unlinked_msg;
239 =item cust_statuscolor
241 Given an object that contains fields from cust_main (say, from a JOINed
242 search; see httemplate/search/ for examples), returns the equivalent of the
243 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
248 sub cust_statuscolor {
252 ? FS::cust_main::cust_statuscolor($self)
266 Class methods that return SQL framents, equivalent to the corresponding
267 FS::cust_main method.
272 # \$self->cust_linked
273 # ? FS::cust_main::${sub}_sql(\$self)
276 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
279 confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
280 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
286 =item cust_search_sql
288 Returns a list of SQL WHERE fragments to search for parameters specified
289 in HASHREF. Valid parameters are:
303 sub cust_search_sql {
304 my($class, $param) = @_;
307 warn "$me cust_search_sql called with params: \n".
308 join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
313 if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
314 push @search, "cust_main.agentnum = $1";
317 #status (prospect active inactive suspended cancelled)
318 if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
319 my $method = $param->{'status'}. '_sql';
320 push @search, $class->$method();
324 my @payby = ref($param->{'payby'})
325 ? @{ $param->{'payby'} }
326 : split(',', $param->{'payby'});
327 @payby = grep /^([A-Z]{4})$/, @payby;
329 push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
332 #here is the agent virtualization
334 $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
340 =item email_search_result HASHREF
342 Emails a notice to the specified customers. Customers without
343 invoice email destinations will be skipped.
351 Queue job for status updates. Required.
355 Hashref of params to the L<search()> method. Required.
359 Message template number (see L<FS::msg_template>). Overrides all
360 of the following options.
380 Returns an error message, or false for success.
382 If any messages fail to send, they will be queued as individual
383 jobs which can be manually retried. If the first ten messages
384 in the job fail, the entire job will abort and return an error.
388 use Storable qw(thaw);
390 use Data::Dumper qw(Dumper);
392 sub email_search_result {
393 my($class, $param) = @_;
395 my $msgnum = $param->{msgnum};
396 my $from = delete $param->{from};
397 my $subject = delete $param->{subject};
398 my $html_body = delete $param->{html_body};
399 my $text_body = delete $param->{text_body};
402 my $job = delete $param->{'job'}
403 or die "email_search_result must run from the job queue.\n";
407 $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
408 or die "msgnum $msgnum not found\n";
411 my $sql_query = $class->search($param->{'search'});
413 my $count_query = delete($sql_query->{'count_query'});
414 my $count_sth = dbh->prepare($count_query)
415 or die "Error preparing $count_query: ". dbh->errstr;
417 or die "Error executing $count_query: ". $count_sth->errstr;
418 my $count_arrayref = $count_sth->fetchrow_arrayref;
419 my $num_cust = $count_arrayref->[0];
421 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
427 #eventually order+limit magic to reduce memory use?
428 foreach my $obj ( qsearch($sql_query) ) {
430 #progressbar first, so that the count is right
432 if ( time - $min_sec > $last ) {
433 my $error = $job->update_statustext(
434 int( 100 * $num / $num_cust )
436 die $error if $error;
440 my $cust_main = $obj->cust_main;
443 next; # unlinked object; nothing else we can do
446 if( $sent_to{$cust_main->custnum} ) {
452 $sent_to{$cust_main->custnum} = 1;
454 if ( $msg_template ) {
455 # XXX add support for other context objects?
456 # If we do that, handling of "duplicates" will
457 # have to be smarter. Currently we limit to
458 # one message per custnum because they'd all
460 @message = $msg_template->prepare( 'cust_main' => $cust_main );
463 my @to = $cust_main->invoicing_list_emailonly;
469 'subject' => $subject,
470 'html_body' => $html_body,
471 'text_body' => $text_body,
472 'custnum' => $cust_main->custnum,
476 $error = send_email( generate_email( @message ) );
479 # queue the sending of this message so that the user can see what we
480 # tried to do, and retry if desired
481 my $queue = new FS::queue {
482 'job' => 'FS::Misc::process_send_email',
483 'custnum' => $cust_main->custnum,
484 'status' => 'failed',
485 'statustext' => $error,
487 $queue->insert(@message);
488 push @retry_jobs, $queue;
495 (scalar(@retry_jobs) > 10 or $num == $num_cust)
497 # 10 is arbitrary, but if we have enough failures, that's
498 # probably a configuration or network problem, and we
499 # abort the batch and run away screaming.
500 # We NEVER do this if anything was successfully sent.
501 $_->delete foreach (@retry_jobs);
502 return "multiple failures: '$error'\n";
507 # fail the job, but with a status message that makes it clear
508 # something was sent.
509 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
515 sub process_email_search_result {
517 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
519 my $param = thaw(decode_base64(shift));
520 warn Dumper($param) if $DEBUG;
522 $param->{'job'} = $job;
524 $param->{'search'} = thaw(decode_base64($param->{'search'}))
525 or die "process_email_search_result requires search params.\n";
527 # $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
528 # unless ref($param->{'payby'});
530 my $table = $param->{'table'}
531 or die "process_email_search_result requires table.\n";
533 eval "use FS::$table;";
534 die "error loading FS::$table: $@\n" if $@;
536 my $error = "FS::$table"->email_search_result( $param );
537 die $error if $error;
543 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
544 if they have one. If not, returns an FS::Conf with no locale.
550 return $self->{_conf} if (ref $self and $self->{_conf});
551 my $cust_main = $self->cust_main;
552 my $conf = new FS::Conf {
553 'locale' => ($cust_main ? $cust_main->locale : '')
555 $self->{_conf} = $conf if ref $self;
559 =item mt TEXT [, ARGS ]
561 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
568 return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
569 my $cust_main = $self->cust_main;
570 my $locale = $cust_main ? $cust_main->locale : '';
571 my $lh = FS::L10N->get_handle($locale);
572 $self->{_lh} = $lh if ref $self;
573 return $lh->maketext(@_);
582 L<FS::cust_main>, L<FS::Record>