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