[freeside-commits] freeside/FS/FS Mason.pm, 1.51, 1.52 cust_main.pm, 1.543, 1.544 cust_main_Mixin.pm, 1.8, 1.9 svc_broadband.pm, 1.21, 1.22
Mark Wells
mark at wavetail.420.am
Fri Sep 17 11:07:09 PDT 2010
Update of /home/cvs/cvsroot/freeside/FS/FS
In directory wavetail.420.am:/tmp/cvs-serv685/FS/FS
Modified Files:
Mason.pm cust_main.pm cust_main_Mixin.pm svc_broadband.pm
Log Message:
email_search_result for cust_pkg and svc_broadband, RT#8736
Index: cust_main_Mixin.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main_Mixin.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -d -r1.8 -r1.9
--- cust_main_Mixin.pm 19 Dec 2009 20:29:48 -0000 1.8
+++ cust_main_Mixin.pm 17 Sep 2010 18:07:07 -0000 1.9
@@ -5,6 +5,8 @@
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]';
@@ -33,6 +35,11 @@
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
@@ -330,6 +337,195 @@
}
+=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<search()> method. Required.
+
+=item msgnum
+
+Message template number (see L<FS::msg_template>). 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
Index: svc_broadband.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/svc_broadband.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -w -d -r1.21 -r1.22
--- svc_broadband.pm 7 Jul 2009 09:23:20 -0000 1.21
+++ svc_broadband.pm 17 Sep 2010 18:07:07 -0000 1.22
@@ -113,6 +113,126 @@
sub table_dupcheck_fields { ( 'mac_addr' ); }
+=item search HASHREF
+
+Class method which returns a qsearch hash expression to search for parameters
+specified in HASHREF.
+
+Parameters:
+
+=over 4
+
+=item unlinked - set to search for all unlinked services. Overrides all other options.
+
+=item agentnum
+
+=item custnum
+
+=item svcpart
+
+=item ip_addr
+
+=item pkgpart - arrayref
+
+=item routernum - arrayref
+
+=item order_by
+
+=back
+
+=cut
+
+sub search {
+ my ($class, $params) = @_;
+ my @where = ();
+ my @from = (
+ 'LEFT JOIN cust_svc USING ( svcnum )',
+ 'LEFT JOIN part_svc USING ( svcpart )',
+ 'LEFT JOIN cust_pkg USING ( pkgnum )',
+ 'LEFT JOIN cust_main USING ( custnum )',
+ );
+
+ # based on FS::svc_acct::search, probably the most mature of the bunch
+ #unlinked
+ push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
+
+ #agentnum
+ if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
+ push @where, "agentnum = $1";
+ }
+ push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
+ 'null_right' => 'View/link unlinked services',
+ 'table' => 'cust_main'
+ );
+
+ #custnum
+ if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
+ push @where, "custnum = $1";
+ }
+
+ #pkgpart, now properly untainted, can be arrayref
+ for my $pkgpart ( $params->{'pkgpart'} ) {
+ if ( ref $pkgpart ) {
+ my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$pkgpart );
+ push @where, "cust_pkg.pkgpart IN ($where)" if $where;
+ }
+ elsif ( $pkgpart =~ /^(\d+)$/ ) {
+ push @where, "cust_pkg.pkgpart = $1";
+ }
+ }
+
+ #routernum, can be arrayref
+ for my $routernum ( $params->{'routernum'} ) {
+ push @from, 'LEFT JOIN addr_block USING ( blocknum )';
+ if ( ref $routernum and grep { $_ } @$routernum ) {
+ my $where = join(',', map { /^(\d+)$/ ? $1 : () } @$routernum );
+ push @where, "addr_block.routernum IN ($where)" if $where;
+ }
+ elsif ( $routernum =~ /^(\d+)$/ ) {
+ push @where, "addr_block.routernum = $1";
+ }
+ }
+
+ #svcnum
+ if ( $params->{'svcnum'} =~ /^(\d+)$/ ) {
+ push @where, "svcnum = $1";
+ }
+
+ #svcpart
+ if ( $params->{'svcpart'} =~ /^(\d+)$/ ) {
+ push @where, "svcpart = $1";
+ }
+
+ #ip_addr
+ if ( $params->{'ip_addr'} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/ ) {
+ push @where, "ip_addr = '$1'";
+ }
+
+ #custnum
+ if ( $params->{'custnum'} =~ /^(\d+)$/ and $1) {
+ push @where, "custnum = $1";
+ }
+
+ my $addl_from = join(' ', @from);
+ my $extra_sql = '';
+ $extra_sql = 'WHERE '.join(' AND ', @where) if @where;
+ my $count_query = "SELECT COUNT(*) FROM svc_broadband $addl_from $extra_sql";
+ return( {
+ 'table' => 'svc_broadband',
+ 'hashref' => {},
+ 'select' => join(', ',
+ 'svc_broadband.*',
+ 'part_svc.svc',
+ 'cust_main.custnum',
+ FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
+ ),
+ 'extra_sql' => $extra_sql,
+ 'addl_from' => $addl_from,
+ 'order_by' => "ORDER BY ".($params->{'order_by'} || 'svcnum'),
+ 'count_query' => $count_query,
+ } );
+}
+
=item search_sql STRING
Class method which returns an SQL fragment to search for the given string.
Index: cust_main.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/cust_main.pm,v
retrieving revision 1.543
retrieving revision 1.544
diff -u -w -d -r1.543 -r1.544
--- cust_main.pm 24 Aug 2010 02:27:46 -0000 1.543
+++ cust_main.pm 17 Sep 2010 18:07:07 -0000 1.544
@@ -2,7 +2,11 @@
require 5.006;
use strict;
-use base qw( FS::otaker_Mixin FS::payinfo_Mixin FS::Record );
+use base qw( FS::otaker_Mixin
+ FS::payinfo_Mixin
+ FS::cust_main_Mixin
+ FS::Record
+ );
use vars qw( @EXPORT_OK $DEBUG $me $conf
@encrypted_fields
$import $ignore_expired_card
@@ -8048,7 +8052,7 @@
? @{ $params->{'payby'} }
: ( $params->{'payby'} );
- @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
+ @payby = grep /^([A-Z]{4})$/, @payby;
push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
if @payby;
@@ -8183,160 +8187,6 @@
}
-=item email_search_result HASHREF
-
-(Class method)
-
-Emails a notice to the specified customers.
-
-Valid parameters are those of the L<search> method, plus the following:
-
-=over 4
-
-=item from
-
-From: address
-
-=item subject
-
-Email Subject:
-
-=item html_body
-
-HTML body
-
-=item text_body
-
-Text body
-
-=item job
-
-Optional job queue job for status updates.
-
-=back
-
-Returns an error message, or false for success.
-
-If an error occurs during any email, stops the enture send and returns that
-error. Presumably if you're getting SMTP errors aborting is better than
-retrying everything.
-
-=cut
-
-sub email_search_result {
- my($class, $params) = @_;
-
- my $from = delete $params->{from};
- my $subject = delete $params->{subject};
- my $html_body = delete $params->{html_body};
- my $text_body = delete $params->{text_body};
- my $error = '';
-
- my $job = delete $params->{'job'}
- or die "email_search_result must run from the job queue.\n";
-
- $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
- unless ref($params->{'payby'});
-
- my $sql_query = $class->search($params);
-
- 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 @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
- #my @extra_fields = @{ delete($sql_query->{'extra_fields'}) };
-
-
- 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 $cust_main ( 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 $to = $cust_main->invoicing_list_emailonly_scalar;
-
- if( $to ) {
- my @message = (
- 'from' => $from,
- 'to' => $to,
- 'subject' => $subject,
- 'html_body' => $html_body,
- 'text_body' => $text_body,
- );
-
- $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";
- }
- }
-
- 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->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
- unless ref($param->{'payby'});
-
- my $error = FS::cust_main->email_search_result( $param );
- die $error if $error;
-
-}
-
=item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
Performs a fuzzy (approximate) search and returns the matching FS::cust_main
Index: Mason.pm
===================================================================
RCS file: /home/cvs/cvsroot/freeside/FS/FS/Mason.pm,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -w -d -r1.51 -r1.52
--- Mason.pm 15 Aug 2010 00:44:54 -0000 1.51
+++ Mason.pm 17 Sep 2010 18:07:07 -0000 1.52
@@ -113,6 +113,7 @@
use Locale::Country;
use Business::US::USPS::WebTools::AddressStandardization;
use LWP::UserAgent;
+ use Storable qw( nfreeze thaw );
use FS;
use FS::UID qw( getotaker dbh datasrc driver_name );
use FS::Record qw( qsearch qsearchs fields dbdef
More information about the freeside-commits
mailing list