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 $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
412 unless ref($param->{'payby'});
414 my $sql_query = $class->search($param->{'search'});
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;
446 next; # unlinked object; nothing else we can do
449 if( $sent_to{$cust_main->custnum} ) {
455 $sent_to{$cust_main->custnum} = 1;
457 if ( $msg_template ) {
458 # XXX add support for other context objects?
459 # If we do that, handling of "duplicates" will
460 # have to be smarter. Currently we limit to
461 # one message per custnum because they'd all
463 @message = $msg_template->prepare( 'cust_main' => $cust_main );
466 my $to = $cust_main->invoicing_list_emailonly_scalar;
472 'subject' => $subject,
473 'html_body' => $html_body,
474 'text_body' => $text_body,
478 $error = send_email( generate_email( @message ) );
481 # queue the sending of this message so that the user can see what we
482 # tried to do, and retry if desired
483 my $queue = new FS::queue {
484 'job' => 'FS::Misc::process_send_email',
485 'custnum' => $cust_main->custnum,
486 'status' => 'failed',
487 'statustext' => $error,
489 $queue->insert(@message);
490 push @retry_jobs, $queue;
497 (scalar(@retry_jobs) > 10 or $num == $num_cust)
499 # 10 is arbitrary, but if we have enough failures, that's
500 # probably a configuration or network problem, and we
501 # abort the batch and run away screaming.
502 # We NEVER do this if anything was successfully sent.
503 $_->delete foreach (@retry_jobs);
504 return "multiple failures: '$error'\n";
509 # fail the job, but with a status message that makes it clear
510 # something was sent.
511 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
517 sub process_email_search_result {
519 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
521 my $param = thaw(decode_base64(shift));
522 warn Dumper($param) if $DEBUG;
524 $param->{'job'} = $job;
526 $param->{'search'} = thaw(decode_base64($param->{'search'}))
527 or die "process_email_search_result requires search params.\n";
529 # $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
530 # unless ref($param->{'payby'});
532 my $table = $param->{'table'}
533 or die "process_email_search_result requires table.\n";
535 eval "use FS::$table;";
536 die "error loading FS::$table: $@\n" if $@;
538 my $error = "FS::$table"->email_search_result( $param );
539 die $error if $error;
549 L<FS::cust_main>, L<FS::Record>