FS/FS/cust_main_Mixin.pm

   1 package FS::cust_main_Mixin;
   2
   3 use strict;
   4 use vars qw( $DEBUG $me );
   5 use Carp qw( confess );
   6 use FS::UID qw(dbh);
   7 use FS::cust_main;
   8 use FS::Record qw( qsearch qsearchs );
   9 use FS::Misc qw( send_email generate_email );
  10
  11 $DEBUG = 0;
  12 $me = '[FS::cust_main_Mixin]';
  13
  14 =head1 NAME
  15
  16 FS::cust_main_Mixin - Mixin class for records that contain fields from cust_main
  17
  18 =head1 SYNOPSIS
  19
  20 package FS::some_table;
  21 use vars qw(@ISA);
  22 @ISA = qw( FS::cust_main_Mixin FS::Record );
  23
  24 =head1 DESCRIPTION
  25
  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.
  28
  29 =head1 METHODS
  30
  31 =over 4
  32
  33 =cut
  34
  35 sub cust_unlinked_msg { '(unlinked)'; }
  36 sub cust_linked { $_[0]->custnum; }
  37
  38 sub cust_main {
  39   my $self = shift;
  40   $self->cust_linked ? qsearchs('cust_main', {custnum => $self->custnum}) : '';
  41 }
  42
  43 =item display_custnum
  44
  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
  48 a customer.
  49
  50 =cut
  51
  52 sub display_custnum {
  53   my $self = shift;
  54   $self->cust_linked
  55     ? FS::cust_main::display_custnum($self)
  56     : $self->cust_unlinked_msg;
  57 }
  58
  59 =item name
  60
  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
  64 a customer.
  65
  66 =cut
  67
  68 sub name {
  69   my $self = shift;
  70   $self->cust_linked
  71     ? FS::cust_main::name($self)
  72     : $self->cust_unlinked_msg;
  73 }
  74
  75 =item ship_name
  76
  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
  80 linked to a customer.
  81
  82 =cut
  83
  84 sub ship_name {
  85   my $self = shift;
  86   $self->cust_linked
  87     ? FS::cust_main::ship_name($self)
  88     : $self->cust_unlinked_msg;
  89 }
  90
  91 =item contact
  92
  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
  96 to a customer.
  97
  98 =cut
  99
 100 sub contact {
 101   my $self = shift;
 102   $self->cust_linked
 103     ? FS::cust_main::contact($self)
 104     : $self->cust_unlinked_msg;
 105 }
 106
 107 =item ship_contact
 108
 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.
 113
 114 =cut
 115
 116 sub ship_contact {
 117   my $self = shift;
 118   $self->cust_linked
 119     ? FS::cust_main::ship_contact($self)
 120     : $self->cust_unlinked_msg;
 121 }
 122
 123 =item country_full
 124
 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.
 129
 130 =cut
 131
 132 sub country_full {
 133   my $self = shift;
 134   $self->cust_linked
 135     ? FS::cust_main::country_full($self)
 136     : $self->cust_unlinked_msg;
 137 }
 138
 139 =item invoicing_list_emailonly
 140
 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.
 145
 146 =cut
 147
 148 sub invoicing_list_emailonly {
 149   my $self = shift;
 150   warn "invoicing_list_email only called on $self, ".
 151        "custnum ". $self->custnum. "\n"
 152     if $DEBUG;
 153   $self->cust_linked
 154     ? FS::cust_main::invoicing_list_emailonly($self)
 155     : $self->cust_unlinked_msg;
 156 }
 157
 158 =item invoicing_list_emailonly_scalar
 159
 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.
 164
 165 =cut
 166
 167 sub invoicing_list_emailonly_scalar {
 168   my $self = shift;
 169   warn "invoicing_list_emailonly called on $self, ".
 170        "custnum ". $self->custnum. "\n"
 171     if $DEBUG;
 172   $self->cust_linked
 173     ? FS::cust_main::invoicing_list_emailonly_scalar($self)
 174     : $self->cust_unlinked_msg;
 175 }
 176
 177 =item invoicing_list
 178
 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.
 183
 184 Note: this method is read-only.
 185
 186 =cut
 187
 188 #read-only
 189 sub invoicing_list {
 190   my $self = shift;
 191   $self->cust_linked
 192     ? FS::cust_main::invoicing_list($self)
 193     : ();
 194 }
 195
 196 =item status
 197
 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
 201 a customer.
 202
 203 =cut
 204
 205 sub cust_status {
 206   my $self = shift;
 207   return $self->cust_unlinked_msg unless $self->cust_linked;
 208
 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];
 220   }
 221 }
 222
 223 =item ucfirst_cust_status
 224
 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.
 229
 230 =cut
 231
 232 sub ucfirst_cust_status {
 233   my $self = shift;
 234   $self->cust_linked
 235     ? ucfirst( $self->cust_status(@_) )
 236     : $self->cust_unlinked_msg;
 237 }
 238
 239 =item cust_statuscolor
 240
 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
 244 a customer.
 245
 246 =cut
 247
 248 sub cust_statuscolor {
 249   my $self = shift;
 250
 251   $self->cust_linked
 252     ? FS::cust_main::cust_statuscolor($self)
 253     : '000000';
 254 }
 255
 256 =item prospect_sql
 257
 258 =item active_sql
 259
 260 =item inactive_sql
 261
 262 =item suspended_sql
 263
 264 =item cancelled_sql
 265
 266 Class methods that return SQL framents, equivalent to the corresponding
 267 FS::cust_main method.
 268
 269 =cut
 270
 271 #      my \$self = shift;
 272 #      \$self->cust_linked
 273 #        ? FS::cust_main::${sub}_sql(\$self)
 274 #        : '0';
 275
 276 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
 277   eval "
 278     sub ${sub}_sql {
 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();
 281     }
 282   ";
 283   die $@ if $@;
 284 }
 285
 286 =item cust_search_sql
 287
 288 Returns a list of SQL WHERE fragments to search for parameters specified
 289 in HASHREF.  Valid parameters are:
 290
 291 =over 4
 292
 293 =item agentnum
 294
 295 =item status
 296
 297 =item payby
 298
 299 =back
 300
 301 =cut
 302
 303 sub cust_search_sql {
 304   my($class, $param) = @_;
 305
 306   if ( $DEBUG ) {
 307     warn "$me cust_search_sql called with params: \n".
 308          join("\n", map { "  $_: ". $param->{$_} } keys %$param ). "\n";
 309   }
 310
 311   my @search = ();
 312
 313   if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
 314     push @search, "cust_main.agentnum = $1";
 315   }
 316
 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();
 321   }
 322
 323   #payby
 324   my @payby = ref($param->{'payby'})
 325                 ? @{ $param->{'payby'} }
 326                 : split(',', $param->{'payby'});
 327   @payby = grep /^([A-Z]{4})$/, @payby;
 328   if ( @payby ) {
 329     push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
 330   }
 331
 332   #here is the agent virtualization
 333   push @search,
 334     $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
 335
 336   return @search;
 337
 338 }
 339
 340 =item email_search_result HASHREF
 341
 342 Emails a notice to the specified customers.  Customers without
 343 invoice email destinations will be skipped.
 344
 345 Parameters:
 346
 347 =over 4
 348
 349 =item job
 350
 351 Queue job for status updates.  Required.
 352
 353 =item search
 354
 355 Hashref of params to the L<search()> method.  Required.
 356
 357 =item msgnum
 358
 359 Message template number (see L<FS::msg_template>).  Overrides all
 360 of the following options.
 361
 362 =item from
 363
 364 From: address
 365
 366 =item subject
 367
 368 Email Subject:
 369
 370 =item html_body
 371
 372 HTML body
 373
 374 =item text_body
 375
 376 Text body
 377
 378 =back
 379
 380 Returns an error message, or false for success.
 381
 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.
 385
 386 =cut
 387
 388 use Storable qw(thaw);
 389 use MIME::Base64;
 390 use Data::Dumper qw(Dumper);
 391
 392 sub email_search_result {
 393   my($class, $param) = @_;
 394
 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};
 400   my $error = '';
 401
 402   my $job = delete $param->{'job'}
 403     or die "email_search_result must run from the job queue.\n";
 404
 405   my $msg_template;
 406   if ( $msgnum ) {
 407     $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
 408       or die "msgnum $msgnum not found\n";
 409   }
 410
 411   $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
 412     unless ref($param->{'payby'});
 413
 414   my $sql_query = $class->search($param->{'search'});
 415
 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;
 419   $count_sth->execute
 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];
 423
 424   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
 425   my @retry_jobs = ();
 426   my $success = 0;
 427
 428   #eventually order+limit magic to reduce memory use?
 429   foreach my $obj ( qsearch($sql_query) ) {
 430
 431     #progressbar first, so that the count is right
 432     $num++;
 433     if ( time - $min_sec > $last ) {
 434       my $error = $job->update_statustext(
 435         int( 100 * $num / $num_cust )
 436       );
 437       die $error if $error;
 438       $last = time;
 439     }
 440
 441     my $cust_main = $obj->cust_main;
 442     my @message;
 443     if ( !$cust_main ) {
 444       next; # unlinked object; nothing else we can do
 445     }
 446
 447     if ( $msg_template ) {
 448       # XXX add support for other context objects?
 449       @message = $msg_template->prepare( 'cust_main' => $cust_main );
 450     }
 451     else {
 452       my $to = $cust_main->invoicing_list_emailonly_scalar;
 453       next if !$to;
 454
 455       @message = (
 456         'from'      => $from,
 457         'to'        => $to,
 458         'subject'   => $subject,
 459         'html_body' => $html_body,
 460         'text_body' => $text_body,
 461       );
 462     } #if $msg_template
 463
 464     $error = send_email( generate_email( @message ) );
 465
 466     if($error) {
 467       # queue the sending of this message so that the user can see what we
 468       # tried to do, and retry if desired
 469       my $queue = new FS::queue {
 470         'job'        => 'FS::Misc::process_send_email',
 471         'custnum'    => $cust_main->custnum,
 472         'status'     => 'failed',
 473         'statustext' => $error,
 474       };
 475       $queue->insert(@message);
 476       push @retry_jobs, $queue;
 477     }
 478     else {
 479       $success++;
 480     }
 481
 482     if($success == 0 and
 483         (scalar(@retry_jobs) > 10 or $num == $num_cust)
 484       ) {
 485       # 10 is arbitrary, but if we have enough failures, that's
 486       # probably a configuration or network problem, and we
 487       # abort the batch and run away screaming.
 488       # We NEVER do this if anything was successfully sent.
 489       $_->delete foreach (@retry_jobs);
 490       return "multiple failures: '$error'\n";
 491     }
 492   } # foreach $obj
 493
 494   if(@retry_jobs) {
 495     # fail the job, but with a status message that makes it clear
 496     # something was sent.
 497     return "Sent $success, failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
 498   }
 499
 500   return '';
 501 }
 502
 503 sub process_email_search_result {
 504   my $job = shift;
 505   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
 506
 507   my $param = thaw(decode_base64(shift));
 508   warn Dumper($param) if $DEBUG;
 509
 510   $param->{'job'} = $job;
 511
 512   $param->{'search'} = thaw(decode_base64($param->{'search'}))
 513     or die "process_email_search_result requires search params.\n";
 514
 515 #  $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
 516 #    unless ref($param->{'payby'});
 517
 518   my $table = $param->{'table'}
 519     or die "process_email_search_result requires table.\n";
 520
 521   eval "use FS::$table;";
 522   die "error loading FS::$table: $@\n" if $@;
 523
 524   my $error = "FS::$table"->email_search_result( $param );
 525   die $error if $error;
 526
 527 }
 528
 529 =back
 530
 531 =head1 BUGS
 532
 533 =head1 SEE ALSO
 534
 535 L<FS::cust_main>, L<FS::Record>
 536
 537 =cut
 538
 539 1;
 540