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.
134 if ( $self->locationnum ) { # cust_pkg has this
135 my $location = FS::cust_location->by_key($self->locationnum);
136 $location ? $location->country_full : '';
137 } elsif ( $self->cust_linked ) {
138 $self->cust_main->bill_country_full;
142 =item invoicing_list_emailonly
144 Given an object that contains fields from cust_main (say, from a JOINed
145 search; see httemplate/search/ for examples), returns the equivalent of the
146 FS::cust_main I<invoicing_list_emailonly> method, or "(unlinked)" if this
147 object is not linked to a customer.
151 sub invoicing_list_emailonly {
153 warn "invoicing_list_email only called on $self, ".
154 "custnum ". $self->custnum. "\n"
157 ? FS::cust_main::invoicing_list_emailonly($self)
158 : $self->cust_unlinked_msg;
161 =item invoicing_list_emailonly_scalar
163 Given an object that contains fields from cust_main (say, from a JOINed
164 search; see httemplate/search/ for examples), returns the equivalent of the
165 FS::cust_main I<invoicing_list_emailonly_scalar> method, or "(unlinked)" if
166 this object is not linked to a customer.
170 sub invoicing_list_emailonly_scalar {
172 warn "invoicing_list_emailonly called on $self, ".
173 "custnum ". $self->custnum. "\n"
176 ? FS::cust_main::invoicing_list_emailonly_scalar($self)
177 : $self->cust_unlinked_msg;
182 Given an object that contains fields from cust_main (say, from a JOINed
183 search; see httemplate/search/ for examples), returns the equivalent of the
184 FS::cust_main I<invoicing_list> method, or "(unlinked)" if this object is not
185 linked to a customer.
187 Note: this method is read-only.
195 ? FS::cust_main::invoicing_list($self)
201 Given an object that contains fields from cust_main (say, from a JOINed
202 search; see httemplate/search/ for examples), returns the equivalent of the
203 FS::cust_main I<status> method, or "(unlinked)" if this object is not linked to
210 return $self->cust_unlinked_msg unless $self->cust_linked;
212 #FS::cust_main::status($self)
213 #false laziness w/actual cust_main::status
214 # (make sure FS::cust_main methods are called)
215 for my $status (qw( prospect active inactive suspended cancelled )) {
216 my $method = $status.'_sql';
217 my $sql = FS::cust_main->$method();;
218 my $numnum = ( $sql =~ s/cust_main\.custnum/?/g );
219 my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
220 $sth->execute( ($self->custnum) x $numnum )
221 or die "Error executing 'SELECT $sql': ". $sth->errstr;
222 return $status if $sth->fetchrow_arrayref->[0];
226 =item ucfirst_cust_status
228 Given an object that contains fields from cust_main (say, from a JOINed
229 search; see httemplate/search/ for examples), returns the equivalent of the
230 FS::cust_main I<ucfirst_status> method, or "(unlinked)" if this object is not
231 linked to a customer.
235 sub ucfirst_cust_status {
238 ? ucfirst( $self->cust_status(@_) )
239 : $self->cust_unlinked_msg;
242 =item cust_statuscolor
244 Given an object that contains fields from cust_main (say, from a JOINed
245 search; see httemplate/search/ for examples), returns the equivalent of the
246 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
251 sub cust_statuscolor {
255 ? FS::cust_main::cust_statuscolor($self)
269 Class methods that return SQL framents, equivalent to the corresponding
270 FS::cust_main method.
275 # \$self->cust_linked
276 # ? FS::cust_main::${sub}_sql(\$self)
279 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
282 confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
283 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
289 =item cust_search_sql
291 Returns a list of SQL WHERE fragments to search for parameters specified
292 in HASHREF. Valid parameters are:
306 sub cust_search_sql {
307 my($class, $param) = @_;
310 warn "$me cust_search_sql called with params: \n".
311 join("\n", map { " $_: ". $param->{$_} } keys %$param ). "\n";
316 if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
317 push @search, "cust_main.agentnum = $1";
320 #status (prospect active inactive suspended cancelled)
321 if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
322 my $method = $param->{'status'}. '_sql';
323 push @search, $class->$method();
327 my @payby = ref($param->{'payby'})
328 ? @{ $param->{'payby'} }
329 : split(',', $param->{'payby'});
330 @payby = grep /^([A-Z]{4})$/, @payby;
332 push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
335 #here is the agent virtualization
337 $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
343 =item email_search_result HASHREF
345 Emails a notice to the specified customers. Customers without
346 invoice email destinations will be skipped.
354 Queue job for status updates. Required.
358 Hashref of params to the L<search()> method. Required.
362 Message template number (see L<FS::msg_template>). Overrides all
363 of the following options.
383 Returns an error message, or false for success.
385 If any messages fail to send, they will be queued as individual
386 jobs which can be manually retried. If the first ten messages
387 in the job fail, the entire job will abort and return an error.
391 use Storable qw(thaw);
393 use Data::Dumper qw(Dumper);
394 use Digest::SHA qw(sha1); # for duplicate checking
396 sub email_search_result {
397 my($class, $param) = @_;
399 my $msgnum = $param->{msgnum};
400 my $from = delete $param->{from};
401 my $subject = delete $param->{subject};
402 my $html_body = delete $param->{html_body};
403 my $text_body = delete $param->{text_body};
406 my $job = delete $param->{'job'}
407 or die "email_search_result must run from the job queue.\n";
411 $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
412 or die "msgnum $msgnum not found\n";
415 my $sql_query = $class->search($param->{'search'});
416 $sql_query->{'select'} = $sql_query->{'table'} . '.*';
418 my $count_query = delete($sql_query->{'count_query'});
419 my $count_sth = dbh->prepare($count_query)
420 or die "Error preparing $count_query: ". dbh->errstr;
422 or die "Error executing $count_query: ". $count_sth->errstr;
423 my $count_arrayref = $count_sth->fetchrow_arrayref;
424 my $num_cust = $count_arrayref->[0];
426 my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
432 #eventually order+limit magic to reduce memory use?
433 foreach my $obj ( qsearch($sql_query) ) {
435 #progressbar first, so that the count is right
437 if ( time - $min_sec > $last ) {
438 my $error = $job->update_statustext(
439 int( 100 * $num / $num_cust )
441 die $error if $error;
445 my $cust_main = $obj->cust_main;
446 tie my %message, 'Tie::IxHash';
448 next; # unlinked object; nothing else we can do
451 if ( $msg_template ) {
452 # Now supports other context objects.
453 %message = $msg_template->prepare(
454 'cust_main' => $cust_main,
459 my @to = $cust_main->invoicing_list_emailonly;
465 'subject' => $subject,
466 'html_body' => $html_body,
467 'text_body' => $text_body,
468 'custnum' => $cust_main->custnum,
472 # For non-cust_main searches, we avoid duplicates based on message
474 my $unique = $cust_main->custnum;
475 $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main';
476 if( $sent_to{$unique} ) {
482 $sent_to{$unique} = 1;
484 $error = send_email( generate_email( %message ) );
487 # queue the sending of this message so that the user can see what we
488 # tried to do, and retry if desired
489 my $queue = new FS::queue {
490 'job' => 'FS::Misc::process_send_email',
491 'custnum' => $cust_main->custnum,
492 'status' => 'failed',
493 'statustext' => $error,
495 $queue->insert(%message);
496 push @retry_jobs, $queue;
503 (scalar(@retry_jobs) > 10 or $num == $num_cust)
505 # 10 is arbitrary, but if we have enough failures, that's
506 # probably a configuration or network problem, and we
507 # abort the batch and run away screaming.
508 # We NEVER do this if anything was successfully sent.
509 $_->delete foreach (@retry_jobs);
510 return "multiple failures: '$error'\n";
515 # fail the job, but with a status message that makes it clear
516 # something was sent.
517 return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
523 sub process_email_search_result {
525 #warn "$me process_re_X $method for job $job\n" if $DEBUG;
527 my $param = thaw(decode_base64(shift));
528 warn Dumper($param) if $DEBUG;
530 $param->{'job'} = $job;
532 $param->{'search'} = thaw(decode_base64($param->{'search'}))
533 or die "process_email_search_result requires search params.\n";
535 # $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
536 # unless ref($param->{'payby'});
538 my $table = $param->{'table'}
539 or die "process_email_search_result requires table.\n";
541 eval "use FS::$table;";
542 die "error loading FS::$table: $@\n" if $@;
544 my $error = "FS::$table"->email_search_result( $param );
545 dbh->commit; # save failed jobs before rethrowing the error
546 die $error if $error;
552 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
553 if they have one. If not, returns an FS::Conf with no locale.
559 return $self->{_conf} if (ref $self and $self->{_conf});
560 my $cust_main = $self->cust_main;
561 my $conf = new FS::Conf {
562 'locale' => ($cust_main ? $cust_main->locale : '')
564 $self->{_conf} = $conf if ref $self;
568 =item mt TEXT [, ARGS ]
570 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
577 return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
578 my $cust_main = $self->cust_main;
579 my $locale = $cust_main ? $cust_main->locale : '';
580 my $lh = FS::L10N->get_handle($locale);
581 $self->{_lh} = $lh if ref $self;
582 return $lh->maketext(@_);
591 L<FS::cust_main>, L<FS::Record>