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   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;
 139   }
 140 }
 141
 142 =item invoicing_list_emailonly
 143
 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.
 148
 149 =cut
 150
 151 sub invoicing_list_emailonly {
 152   my $self = shift;
 153   warn "invoicing_list_email only called on $self, ".
 154        "custnum ". $self->custnum. "\n"
 155     if $DEBUG;
 156   $self->cust_linked
 157     ? FS::cust_main::invoicing_list_emailonly($self)
 158     : $self->cust_unlinked_msg;
 159 }
 160
 161 =item invoicing_list_emailonly_scalar
 162
 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.
 167
 168 =cut
 169
 170 sub invoicing_list_emailonly_scalar {
 171   my $self = shift;
 172   warn "invoicing_list_emailonly called on $self, ".
 173        "custnum ". $self->custnum. "\n"
 174     if $DEBUG;
 175   $self->cust_linked
 176     ? FS::cust_main::invoicing_list_emailonly_scalar($self)
 177     : $self->cust_unlinked_msg;
 178 }
 179
 180 =item invoicing_list
 181
 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.
 186
 187 Note: this method is read-only.
 188
 189 =cut
 190
 191 #read-only
 192 sub invoicing_list {
 193   my $self = shift;
 194   $self->cust_linked
 195     ? FS::cust_main::invoicing_list($self)
 196     : ();
 197 }
 198
 199 =item status
 200
 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
 204 a customer.
 205
 206 =cut
 207
 208 sub cust_status {
 209   my $self = shift;
 210   return $self->cust_unlinked_msg unless $self->cust_linked;
 211
 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];
 223   }
 224 }
 225
 226 =item ucfirst_cust_status
 227
 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.
 232
 233 =cut
 234
 235 sub ucfirst_cust_status {
 236   my $self = shift;
 237   $self->cust_linked
 238     ? ucfirst( $self->cust_status(@_) )
 239     : $self->cust_unlinked_msg;
 240 }
 241
 242 =item cust_statuscolor
 243
 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
 247 a customer.
 248
 249 =cut
 250
 251 sub cust_statuscolor {
 252   my $self = shift;
 253
 254   $self->cust_linked
 255     ? FS::cust_main::cust_statuscolor($self)
 256     : '000000';
 257 }
 258
 259 =item prospect_sql
 260
 261 =item active_sql
 262
 263 =item inactive_sql
 264
 265 =item suspended_sql
 266
 267 =item cancelled_sql
 268
 269 Class methods that return SQL framents, equivalent to the corresponding
 270 FS::cust_main method.
 271
 272 =cut
 273
 274 #      my \$self = shift;
 275 #      \$self->cust_linked
 276 #        ? FS::cust_main::${sub}_sql(\$self)
 277 #        : '0';
 278
 279 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
 280   eval "
 281     sub ${sub}_sql {
 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();
 284     }
 285   ";
 286   die $@ if $@;
 287 }
 288
 289 =item cust_search_sql
 290
 291 Returns a list of SQL WHERE fragments to search for parameters specified
 292 in HASHREF.  Valid parameters are:
 293
 294 =over 4
 295
 296 =item agentnum
 297
 298 =item status
 299
 300 =item payby
 301
 302 =back
 303
 304 =cut
 305
 306 sub cust_search_sql {
 307   my($class, $param) = @_;
 308
 309   if ( $DEBUG ) {
 310     warn "$me cust_search_sql called with params: \n".
 311          join("\n", map { "  $_: ". $param->{$_} } keys %$param ). "\n";
 312   }
 313
 314   my @search = ();
 315
 316   if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
 317     push @search, "cust_main.agentnum = $1";
 318   }
 319
 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();
 324   }
 325
 326   #payby
 327   my @payby = ref($param->{'payby'})
 328                 ? @{ $param->{'payby'} }
 329                 : split(',', $param->{'payby'});
 330   @payby = grep /^([A-Z]{4})$/, @payby;
 331   if ( @payby ) {
 332     push @search, 'cust_main.payby IN ('. join(',', map "'$_'", @payby). ')';
 333   }
 334
 335   #here is the agent virtualization
 336   push @search,
 337     $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
 338
 339   return @search;
 340
 341 }
 342
 343 =item email_search_result HASHREF
 344
 345 Emails a notice to the specified customers.  Customers without
 346 invoice email destinations will be skipped.
 347
 348 Parameters:
 349
 350 =over 4
 351
 352 =item job
 353
 354 Queue job for status updates.  Required.
 355
 356 =item search
 357
 358 Hashref of params to the L<search()> method.  Required.
 359
 360 =item msgnum
 361
 362 Message template number (see L<FS::msg_template>).  Overrides all
 363 of the following options.
 364
 365 =item from
 366
 367 From: address
 368
 369 =item subject
 370
 371 Email Subject:
 372
 373 =item html_body
 374
 375 HTML body
 376
 377 =item text_body
 378
 379 Text body
 380
 381 =back
 382
 383 Returns an error message, or false for success.
 384
 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.
 388
 389 =cut
 390
 391 use Storable qw(thaw);
 392 use MIME::Base64;
 393 use Data::Dumper qw(Dumper);
 394 use Digest::SHA qw(sha1); # for duplicate checking
 395
 396 sub email_search_result {
 397   my($class, $param) = @_;
 398
 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};
 404   my $error = '';
 405
 406   my $job = delete $param->{'job'}
 407     or die "email_search_result must run from the job queue.\n";
 408
 409   my $msg_template;
 410   if ( $msgnum ) {
 411     $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
 412       or die "msgnum $msgnum not found\n";
 413   }
 414
 415   my $sql_query = $class->search($param->{'search'});
 416   $sql_query->{'select'} = $sql_query->{'table'} . '.*';
 417
 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;
 421   $count_sth->execute
 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];
 425
 426   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
 427   my @retry_jobs = ();
 428   my $dups = 0;
 429   my $success = 0;
 430   my %sent_to = ();
 431
 432   #eventually order+limit magic to reduce memory use?
 433   foreach my $obj ( qsearch($sql_query) ) {
 434
 435     #progressbar first, so that the count is right
 436     $num++;
 437     if ( time - $min_sec > $last ) {
 438       my $error = $job->update_statustext(
 439         int( 100 * $num / $num_cust )
 440       );
 441       die $error if $error;
 442       $last = time;
 443     }
 444
 445     my $cust_main = $obj->cust_main;
 446     tie my %message, 'Tie::IxHash';
 447     if ( !$cust_main ) {
 448       next; # unlinked object; nothing else we can do
 449     }
 450
 451     if ( $msg_template ) {
 452       # Now supports other context objects.
 453       %message = $msg_template->prepare(
 454         'cust_main' => $cust_main,
 455         'object'    => $obj,
 456       );
 457     }
 458     else {
 459       my @to = $cust_main->invoicing_list_emailonly;
 460       next if !@to;
 461
 462       %message = (
 463         'from'      => $from,
 464         'to'        => \@to,
 465         'subject'   => $subject,
 466         'html_body' => $html_body,
 467         'text_body' => $text_body,
 468         'custnum'   => $cust_main->custnum,
 469       );
 470     } #if $msg_template
 471
 472     # For non-cust_main searches, we avoid duplicates based on message
 473     # body text.
 474     my $unique = $cust_main->custnum;
 475     $unique .= sha1($message{'text_body'}) if $class ne 'FS::cust_main';
 476     if( $sent_to{$unique} ) {
 477       # avoid duplicates
 478       $dups++;
 479       next;
 480     }
 481
 482     $sent_to{$unique} = 1;
 483
 484     $error = send_email( generate_email( %message ) );
 485
 486     if($error) {
 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,
 494       };
 495       $queue->insert(%message);
 496       push @retry_jobs, $queue;
 497     }
 498     else {
 499       $success++;
 500     }
 501
 502     if($success == 0 and
 503         (scalar(@retry_jobs) > 10 or $num == $num_cust)
 504       ) {
 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";
 511     }
 512   } # foreach $obj
 513
 514   if(@retry_jobs) {
 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";
 518   }
 519
 520   return '';
 521 }
 522
 523 sub process_email_search_result {
 524   my $job = shift;
 525   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
 526
 527   my $param = thaw(decode_base64(shift));
 528   warn Dumper($param) if $DEBUG;
 529
 530   $param->{'job'} = $job;
 531
 532   $param->{'search'} = thaw(decode_base64($param->{'search'}))
 533     or die "process_email_search_result requires search params.\n";
 534
 535 #  $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
 536 #    unless ref($param->{'payby'});
 537
 538   my $table = $param->{'table'}
 539     or die "process_email_search_result requires table.\n";
 540
 541   eval "use FS::$table;";
 542   die "error loading FS::$table: $@\n" if $@;
 543
 544   my $error = "FS::$table"->email_search_result( $param );
 545   dbh->commit; # save failed jobs before rethrowing the error
 546   die $error if $error;
 547
 548 }
 549
 550 =item conf
 551
 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.
 554
 555 =cut
 556
 557 sub conf {
 558   my $self = shift;
 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 : '')
 563   };
 564   $self->{_conf} = $conf if ref $self;
 565   return $conf;
 566 }
 567
 568 =item mt TEXT [, ARGS ]
 569
 570 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
 571 if they have one.
 572
 573 =cut
 574
 575 sub mt {
 576   my $self = shift;
 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(@_);
 583 }
 584
 585 =item time2str_local FORMAT, TIME
 586
 587 Localizes a date (see L<Date::Language>) for the customer's locale.
 588
 589 =cut
 590
 591 sub time2str_local {
 592   # renamed so that we don't have to change every single reference to
 593   # time2str everywhere
 594   my $self = shift;
 595   if (!exists($self->{_dh})) {
 596     my $cust_main = $self->cust_main;
 597     my $locale = $cust_main->locale  if $cust_main;
 598     $locale ||= 'en_US';
 599     my %info = FS::Locales->locale_info($locale);
 600     my $dh = eval { Date::Language->new($info{'name'}) } ||
 601              Date::Language->new(); # fall back to English
 602     $self->{_dh} = $dh;
 603   }
 604   $self->{_dh}->time2str(@_);
 605 }
 606
 607 =back
 608
 609 =head1 BUGS
 610
 611 =head1 SEE ALSO
 612
 613 L<FS::cust_main>, L<FS::Record>
 614
 615 =cut
 616
 617 1;
 618