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);
391 use Digest::SHA qw(sha1); # for duplicate checking
393 sub email_search_result {
394 my($class, $param) = @_;
396 my $msgnum = $param->{msgnum};
397 my $from = delete $param->{from};
398 my $subject = delete $param->{subject};
399 my $html_body = delete $param->{html_body};
400 my $text_body = delete $param->{text_body};
403 my $job = delete $param->{'job'}
404 or die "email_search_result must run from the job queue.\n";
408 $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
409 or die "msgnum $msgnum not found\n";
412 my $sql_query = $class->search($param->{'search'});
413 $sql_query->{'select'} = $sql_query->{'table'} . '.*';
415 my $count_query = delete($sql_query->{'count_query'});
416 my $count_sth = dbh->prepare($count_query)
417 or die "Error preparing $count_query: ". dbh->errstr;
419 or die "Error executing $count_query: ". $count_sth->errstr;
420 my $count_arrayref = $count_sth->fetchrow_arrayref;
421 my $num_cust = $count_arrayref->[0];
423 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
429 #eventually order+limit magic to reduce memory use?
430 foreach my $obj ( qsearch($sql_query) ) {
432 #progressbar first, so that the count is right
434 if ( time - $min_sec > $last ) {
435 my $error = $job->update_statustext(
436 int( 100 * $num / $num_cust )
438 die $error if $error;
442 my $cust_main = $obj->cust_main;
443 tie my %message, 'Tie::IxHash';
445 next; # unlinked object; nothing else we can do
448 if ( $msg_template ) {
449 # Now supports other context objects.
450 %message = $msg_template->prepare(
451 'cust_main' => $cust_main,
456 my @to = $cust_main->invoicing_list_emailonly;
462 'subject' => $subject,
463 'html_body' => $html_body,
464 'text_body' => $text_body,
465 'custnum' => $cust_main->custnum,
469 # For non-cust_main searches, we avoid duplicates based on message
471 my $unique = $cust_main->custnum;
472 $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main';
473 if( $sent_to{$unique} ) {
479 $sent_to{$unique} = 1;
481 $error = send_email( generate_email( %message ) );
484 # queue the sending of this message so that the user can see what we
485 # tried to do, and retry if desired
486 my $queue = new FS::queue {
487 'job' => 'FS::Misc::process_send_email',
488 'custnum' => $cust_main->custnum,
489 'status' => 'failed',
490 'statustext' => $error,
492 $queue->insert(%message);
493 push @retry_jobs, $queue;
500 (scalar(@retry_jobs) > 10 or $num == $num_cust)
502 # 10 is arbitrary, but if we have enough failures, that's
503 # probably a configuration or network problem, and we
504 # abort the batch and run away screaming.
505 # We NEVER do this if anything was successfully sent.
506 $_->delete foreach (@retry_jobs);
507 return "multiple failures: '$error'\n";
512 # fail the job, but with a status message that makes it clear
513 # something was sent.
514 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
520 sub process_email_search_result {
522 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
524 my $param = thaw(decode_base64(shift));
525 warn Dumper($param) if $DEBUG;
527 $param->{'job'} = $job;
529 $param->{'search'} = thaw(decode_base64($param->{'search'}))
530 or die "process_email_search_result requires search params.\n";
532 # $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
533 # unless ref($param->{'payby'});
535 my $table = $param->{'table'}
536 or die "process_email_search_result requires table.\n";
538 eval "use FS::$table;";
539 die "error loading FS::$table: $@\n" if $@;
541 my $error = "FS::$table"->email_search_result( $param );
542 die $error if $error;
548 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
549 if they have one. If not, returns an FS::Conf with no locale.
555 return $self->{_conf} if (ref $self and $self->{_conf});
556 my $cust_main = $self->cust_main;
557 my $conf = new FS::Conf {
558 'locale' => ($cust_main ? $cust_main->locale : '')
560 $self->{_conf} = $conf if ref $self;
564 =item mt TEXT [, ARGS ]
566 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
573 return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
574 my $cust_main = $self->cust_main;
575 my $locale = $cust_main ? $cust_main->locale : '';
576 my $lh = FS::L10N->get_handle($locale);
577 $self->{_lh} = $lh if ref $self;
578 return $lh->maketext(@_);
587 L<FS::cust_main>, L<FS::Record>