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 use Digest::SHA qw(sha1); # for duplicate checking
 392
 393 sub email_search_result {
 394   my($class, $param) = @_;
 395
 396   my $msgnum = $param->{msgnum};
 397   my $from = delete $param->{from};
 398   my $subject = delete $param->{subject};
 399   my $html_body = delete $param->{html_body};
 400   my $text_body = delete $param->{text_body};
 401   my $error = '';
 402
 403   my $job = delete $param->{'job'}
 404     or die "email_search_result must run from the job queue.\n";
 405
 406   my $msg_template;
 407   if ( $msgnum ) {
 408     $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
 409       or die "msgnum $msgnum not found\n";
 410   }
 411
 412   my $sql_query = $class->search($param->{'search'});
 413   $sql_query->{'select'} = $sql_query->{'table'} . '.*';
 414
 415   my $count_query   = delete($sql_query->{'count_query'});
 416   my $count_sth = dbh->prepare($count_query)
 417     or die "Error preparing $count_query: ". dbh->errstr;
 418   $count_sth->execute
 419     or die "Error executing $count_query: ". $count_sth->errstr;
 420   my $count_arrayref = $count_sth->fetchrow_arrayref;
 421   my $num_cust = $count_arrayref->[0];
 422
 423   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
 424   my @retry_jobs = ();
 425   my $dups = 0;
 426   my $success = 0;
 427   my %sent_to = ();
 428
 429   #eventually order+limit magic to reduce memory use?
 430   foreach my $obj ( qsearch($sql_query) ) {
 431
 432     #progressbar first, so that the count is right
 433     $num++;
 434     if ( time - $min_sec > $last ) {
 435       my $error = $job->update_statustext(
 436         int( 100 * $num / $num_cust )
 437       );
 438       die $error if $error;
 439       $last = time;
 440     }
 441
 442     my $cust_main = $obj->cust_main;
 443     tie my %message, 'Tie::IxHash';
 444     if ( !$cust_main ) {
 445       next; # unlinked object; nothing else we can do
 446     }
 447
 448     if ( $msg_template ) {
 449       # Now supports other context objects.
 450       %message = $msg_template->prepare(
 451         'cust_main' => $cust_main,
 452         'object'    => $obj,
 453       );
 454     }
 455     else {
 456       my @to = $cust_main->invoicing_list_emailonly;
 457       next if !@to;
 458
 459       %message = (
 460         'from'      => $from,
 461         'to'        => \@to,
 462         'subject'   => $subject,
 463         'html_body' => $html_body,
 464         'text_body' => $text_body,
 465         'custnum'   => $cust_main->custnum,
 466       );
 467     } #if $msg_template
 468
 469     # For non-cust_main searches, we avoid duplicates based on message
 470     # body text.
 471     my $unique = $cust_main->custnum;
 472     $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main';
 473     if( $sent_to{$unique} ) {
 474       # avoid duplicates
 475       $dups++;
 476       next;
 477     }
 478
 479     $sent_to{$unique} = 1;
 480
 481     $error = send_email( generate_email( %message ) );
 482
 483     if($error) {
 484       # queue the sending of this message so that the user can see what we
 485       # tried to do, and retry if desired
 486       my $queue = new FS::queue {
 487         'job'        => 'FS::Misc::process_send_email',
 488         'custnum'    => $cust_main->custnum,
 489         'status'     => 'failed',
 490         'statustext' => $error,
 491       };
 492       $queue->insert(%message);
 493       push @retry_jobs, $queue;
 494     }
 495     else {
 496       $success++;
 497     }
 498
 499     if($success == 0 and
 500         (scalar(@retry_jobs) > 10 or $num == $num_cust)
 501       ) {
 502       # 10 is arbitrary, but if we have enough failures, that's
 503       # probably a configuration or network problem, and we
 504       # abort the batch and run away screaming.
 505       # We NEVER do this if anything was successfully sent.
 506       $_->delete foreach (@retry_jobs);
 507       return "multiple failures: '$error'\n";
 508     }
 509   } # foreach $obj
 510
 511   if(@retry_jobs) {
 512     # fail the job, but with a status message that makes it clear
 513     # something was sent.
 514     return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
 515   }
 516
 517   return '';
 518 }
 519
 520 sub process_email_search_result {
 521   my $job = shift;
 522   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
 523
 524   my $param = thaw(decode_base64(shift));
 525   warn Dumper($param) if $DEBUG;
 526
 527   $param->{'job'} = $job;
 528
 529   $param->{'search'} = thaw(decode_base64($param->{'search'}))
 530     or die "process_email_search_result requires search params.\n";
 531
 532 #  $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
 533 #    unless ref($param->{'payby'});
 534
 535   my $table = $param->{'table'}
 536     or die "process_email_search_result requires table.\n";
 537
 538   eval "use FS::$table;";
 539   die "error loading FS::$table: $@\n" if $@;
 540
 541   my $error = "FS::$table"->email_search_result( $param );
 542   die $error if $error;
 543
 544 }
 545
 546 =item conf
 547
 548 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
 549 if they have one.  If not, returns an FS::Conf with no locale.
 550
 551 =cut
 552
 553 sub conf {
 554   my $self = shift;
 555   return $self->{_conf} if (ref $self and $self->{_conf});
 556   my $cust_main = $self->cust_main;
 557   my $conf = new FS::Conf {
 558     'locale' => ($cust_main ? $cust_main->locale : '')
 559   };
 560   $self->{_conf} = $conf if ref $self;
 561   return $conf;
 562 }
 563
 564 =item mt TEXT [, ARGS ]
 565
 566 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
 567 if they have one.
 568
 569 =cut
 570
 571 sub mt {
 572   my $self = shift;
 573   return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
 574   my $cust_main = $self->cust_main;
 575   my $locale = $cust_main ? $cust_main->locale : '';
 576   my $lh = FS::L10N->get_handle($locale);
 577   $self->{_lh} = $lh if ref $self;
 578   return $lh->maketext(@_);
 579 }
 580
 581 =back
 582
 583 =head1 BUGS
 584
 585 =head1 SEE ALSO
 586
 587 L<FS::cust_main>, L<FS::Record>
 588
 589 =cut
 590
 591 1;
 592