X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main_Mixin.pm;h=b446d69651348ed0972525ddb1ab547a1e9cc6cf;hp=5a29a4c2294ebcb254134f1fe0e102527f09a81a;hb=6c9cd1c36adbb9fc950fcf0a0b269fa6f16838a1;hpb=2c7d4f461a5d42178e88d04c34a3f8ca256ee285 diff --git a/FS/FS/cust_main_Mixin.pm b/FS/FS/cust_main_Mixin.pm index 5a29a4c22..b446d6965 100644 --- a/FS/FS/cust_main_Mixin.pm +++ b/FS/FS/cust_main_Mixin.pm @@ -2,8 +2,11 @@ package FS::cust_main_Mixin; use strict; use vars qw( $DEBUG $me ); +use Carp qw( confess ); use FS::UID qw(dbh); use FS::cust_main; +use FS::Record qw( qsearch qsearchs ); +use FS::Misc qw( send_email generate_email ); $DEBUG = 0; $me = '[FS::cust_main_Mixin]'; @@ -32,6 +35,11 @@ for example, from a JOINed search. See httemplate/search/ for examples. sub cust_unlinked_msg { '(unlinked)'; } sub cust_linked { $_[0]->custnum; } +sub cust_main { + my $self = shift; + $self->cust_linked ? qsearchs('cust_main', {custnum => $self->custnum}) : ''; +} + =item display_custnum Given an object that contains fields from cust_main (say, from a JOINed @@ -255,21 +263,22 @@ sub cust_statuscolor { =item cancelled_sql -Given an object that contains fields from cust_main (say, from a JOINed -search; see httemplate/search/ for examples), returns the equivalent of the -corresponding FS::cust_main method, or "0" if this object is not linked to -a customer. +Class methods that return SQL framents, equivalent to the corresponding +FS::cust_main method. =cut +# my \$self = shift; +# \$self->cust_linked +# ? FS::cust_main::${sub}_sql(\$self) +# : '0'; + foreach my $sub (qw( prospect active inactive suspended cancelled )) { eval " sub ${sub}_sql { - my \$self = shift; - \$self->cust_linked - ? FS::cust_main::${sub}_sql(\$self) - : '0'; - } + confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]); + 'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql(); + } "; die $@ if $@; } @@ -328,6 +337,195 @@ sub cust_search_sql { } +=item email_search_result HASHREF + +Emails a notice to the specified customers. Customers without +invoice email destinations will be skipped. + +Parameters: + +=over 4 + +=item job + +Queue job for status updates. Required. + +=item search + +Hashref of params to the L method. Required. + +=item msgnum + +Message template number (see L). Overrides all +of the following options. + +=item from + +From: address + +=item subject + +Email Subject: + +=item html_body + +HTML body + +=item text_body + +Text body + +=back + +Returns an error message, or false for success. + +If any messages fail to send, they will be queued as individual +jobs which can be manually retried. If the first ten messages +in the job fail, the entire job will abort and return an error. + +=cut + +use Storable qw(thaw); +use MIME::Base64; +use Data::Dumper qw(Dumper); + +sub email_search_result { + my($class, $param) = @_; + + my $msgnum = $param->{msgnum}; + my $from = delete $param->{from}; + my $subject = delete $param->{subject}; + my $html_body = delete $param->{html_body}; + my $text_body = delete $param->{text_body}; + my $error = ''; + + my $job = delete $param->{'job'} + or die "email_search_result must run from the job queue.\n"; + + my $msg_template; + if ( $msgnum ) { + $msg_template = qsearchs('msg_template', { msgnum => $msgnum } ) + or die "msgnum $msgnum not found\n"; + } + + $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ] + unless ref($param->{'payby'}); + + my $sql_query = $class->search($param->{'search'}); + + my $count_query = delete($sql_query->{'count_query'}); + my $count_sth = dbh->prepare($count_query) + or die "Error preparing $count_query: ". dbh->errstr; + $count_sth->execute + or die "Error executing $count_query: ". $count_sth->errstr; + my $count_arrayref = $count_sth->fetchrow_arrayref; + my $num_cust = $count_arrayref->[0]; + + my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo + my @retry_jobs = (); + my $success = 0; + + #eventually order+limit magic to reduce memory use? + foreach my $obj ( qsearch($sql_query) ) { + + #progressbar first, so that the count is right + $num++; + if ( time - $min_sec > $last ) { + my $error = $job->update_statustext( + int( 100 * $num / $num_cust ) + ); + die $error if $error; + $last = time; + } + + my $cust_main = $obj->cust_main; + my @message; + if ( !$cust_main ) { + next; # unlinked object; nothing else we can do + } + + if ( $msg_template ) { + # XXX add support for other context objects? + @message = $msg_template->prepare( 'cust_main' => $cust_main ); + } + else { + my $to = $cust_main->invoicing_list_emailonly_scalar; + next if !$to; + + @message = ( + 'from' => $from, + 'to' => $to, + 'subject' => $subject, + 'html_body' => $html_body, + 'text_body' => $text_body, + ); + } #if $msg_template + + $error = send_email( generate_email( @message ) ); + + if($error) { + # queue the sending of this message so that the user can see what we + # tried to do, and retry if desired + my $queue = new FS::queue { + 'job' => 'FS::Misc::process_send_email', + 'custnum' => $cust_main->custnum, + 'status' => 'failed', + 'statustext' => $error, + }; + $queue->insert(@message); + push @retry_jobs, $queue; + } + else { + $success++; + } + + if($success == 0 and + (scalar(@retry_jobs) > 10 or $num == $num_cust) + ) { + # 10 is arbitrary, but if we have enough failures, that's + # probably a configuration or network problem, and we + # abort the batch and run away screaming. + # We NEVER do this if anything was successfully sent. + $_->delete foreach (@retry_jobs); + return "multiple failures: '$error'\n"; + } + } # foreach $obj + + if(@retry_jobs) { + # fail the job, but with a status message that makes it clear + # something was sent. + return "Sent $success, failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n"; + } + + return ''; +} + +sub process_email_search_result { + my $job = shift; + #warn "$me process_re_X $method for job $job\n" if $DEBUG; + + my $param = thaw(decode_base64(shift)); + warn Dumper($param) if $DEBUG; + + $param->{'job'} = $job; + + $param->{'search'} = thaw(decode_base64($param->{'search'})) + or die "process_email_search_result requires search params.\n"; + +# $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ] +# unless ref($param->{'payby'}); + + my $table = $param->{'table'} + or die "process_email_search_result requires table.\n"; + + eval "use FS::$table;"; + die "error loading FS::$table: $@\n" if $@; + + my $error = "FS::$table"->email_search_result( $param ); + die $error if $error; + +} + =back =head1 BUGS