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 carp cluck );
   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 use HTML::Entities;
  11
  12 $DEBUG = 0;
  13 $me = '[FS::cust_main_Mixin]';
  14
  15 =head1 NAME
  16
  17 FS::cust_main_Mixin - Mixin class for records that contain fields from cust_main
  18
  19 =head1 SYNOPSIS
  20
  21 package FS::some_table;
  22 use vars qw(@ISA);
  23 @ISA = qw( FS::cust_main_Mixin FS::Record );
  24
  25 =head1 DESCRIPTION
  26
  27 This is a mixin class for records that contain fields from the cust_main table,
  28 for example, from a JOINed search.  See httemplate/search/ for examples.
  29
  30 =head1 METHODS
  31
  32 =over 4
  33
  34 =cut
  35
  36 sub cust_unlinked_msg { '(unlinked)'; }
  37 sub cust_linked { $_[0]->custnum; }
  38
  39 sub cust_main {
  40   my $self = shift;
  41   cluck ref($self). '->cust_main called' if $DEBUG;
  42   $self->cust_linked ? qsearchs('cust_main', {custnum => $self->custnum}) : '';
  43 }
  44
  45 =item display_custnum
  46
  47 Given an object that contains fields from cust_main (say, from a JOINed
  48 search; see httemplate/search/ for examples), returns the equivalent of the
  49 FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
  50 a customer.
  51
  52 =cut
  53
  54 sub display_custnum {
  55   my $self = shift;
  56   $self->cust_linked
  57     ? FS::cust_main::display_custnum($self)
  58     : $self->cust_unlinked_msg;
  59 }
  60
  61 =item name
  62
  63 Given an object that contains fields from cust_main (say, from a JOINed
  64 search; see httemplate/search/ for examples), returns the equivalent of the
  65 FS::cust_main I<name> method, or "(unlinked)" if this object is not linked to
  66 a customer.
  67
  68 =cut
  69
  70 sub name {
  71   my $self = shift;
  72   $self->cust_linked
  73     ? FS::cust_main::name($self)
  74     : $self->cust_unlinked_msg;
  75 }
  76
  77 =item ship_name
  78
  79 Given an object that contains fields from cust_main (say, from a JOINed
  80 search; see httemplate/search/ for examples), returns the equivalent of the
  81 FS::cust_main I<ship_name> method, or "(unlinked)" if this object is not
  82 linked to a customer.
  83
  84 =cut
  85
  86 sub ship_name {
  87   my $self = shift;
  88   $self->cust_linked
  89     ? FS::cust_main::ship_name($self)
  90     : $self->cust_unlinked_msg;
  91 }
  92
  93 =item contact
  94
  95 Given an object that contains fields from cust_main (say, from a JOINed
  96 search; see httemplate/search/ for examples), returns the equivalent of the
  97 FS::cust_main I<contact> method, or "(unlinked)" if this object is not linked
  98 to a customer.
  99
 100 =cut
 101
 102 sub contact {
 103   my $self = shift;
 104   $self->cust_linked
 105     ? FS::cust_main::contact($self)
 106     : $self->cust_unlinked_msg;
 107 }
 108
 109 =item ship_contact
 110
 111 Given an object that contains fields from cust_main (say, from a JOINed
 112 search; see httemplate/search/ for examples), returns the equivalent of the
 113 FS::cust_main I<ship_contact> method, or "(unlinked)" if this object is not
 114 linked to a customer.
 115
 116 =cut
 117
 118 sub ship_contact {
 119   my $self = shift;
 120   $self->cust_linked
 121     ? FS::cust_main::ship_contact($self)
 122     : $self->cust_unlinked_msg;
 123 }
 124
 125 =item country_full
 126
 127 Given an object that contains fields from cust_main (say, from a JOINed
 128 search; see httemplate/search/ for examples), returns the equivalent of the
 129 FS::cust_main I<country_full> method, or "(unlinked)" if this object is not
 130 linked to a customer.
 131
 132 =cut
 133
 134 sub country_full {
 135   my $self = shift;
 136   if ( $self->locationnum ) {  # cust_pkg has this
 137     my $location = FS::cust_location->by_key($self->locationnum);
 138     $location ? $location->country_full : '';
 139   } elsif ( $self->cust_linked ) {
 140     $self->cust_main->bill_country_full;
 141   }
 142 }
 143
 144 =item invoicing_list_emailonly
 145
 146 Given an object that contains fields from cust_main (say, from a JOINed
 147 search; see httemplate/search/ for examples), returns the equivalent of the
 148 FS::cust_main I<invoicing_list_emailonly> method, or "(unlinked)" if this
 149 object is not linked to a customer.
 150
 151 =cut
 152
 153 sub invoicing_list_emailonly {
 154   my $self = shift;
 155   warn "invoicing_list_email only called on $self, ".
 156        "custnum ". $self->custnum. "\n"
 157     if $DEBUG;
 158   $self->cust_linked
 159     ? FS::cust_main::invoicing_list_emailonly($self)
 160     : $self->cust_unlinked_msg;
 161 }
 162
 163 =item invoicing_list_emailonly_scalar
 164
 165 Given an object that contains fields from cust_main (say, from a JOINed
 166 search; see httemplate/search/ for examples), returns the equivalent of the
 167 FS::cust_main I<invoicing_list_emailonly_scalar> method, or "(unlinked)" if
 168 this object is not linked to a customer.
 169
 170 =cut
 171
 172 sub invoicing_list_emailonly_scalar {
 173   my $self = shift;
 174   warn "invoicing_list_emailonly called on $self, ".
 175        "custnum ". $self->custnum. "\n"
 176     if $DEBUG;
 177   $self->cust_linked
 178     ? FS::cust_main::invoicing_list_emailonly_scalar($self)
 179     : $self->cust_unlinked_msg;
 180 }
 181
 182 =item invoicing_list
 183
 184 Given an object that contains fields from cust_main (say, from a JOINed
 185 search; see httemplate/search/ for examples), returns the equivalent of the
 186 FS::cust_main I<invoicing_list> method, or "(unlinked)" if this object is not
 187 linked to a customer.
 188
 189 Note: this method is read-only.
 190
 191 =cut
 192
 193 #read-only
 194 sub invoicing_list {
 195   my $self = shift;
 196   $self->cust_linked
 197     ? FS::cust_main::invoicing_list($self)
 198     : ();
 199 }
 200
 201 =item status
 202
 203 Given an object that contains fields from cust_main (say, from a JOINed
 204 search; see httemplate/search/ for examples), returns the equivalent of the
 205 FS::cust_main I<status> method, or "(unlinked)" if this object is not linked to
 206 a customer.
 207
 208 =cut
 209
 210 sub cust_status {
 211   my $self = shift;
 212   return $self->cust_unlinked_msg unless $self->cust_linked;
 213   my $cust_main = $self->cust_main;
 214   return $self->cust_unlinked_msg unless $cust_main;
 215   return $cust_main->cust_status;
 216 }
 217
 218 =item ucfirst_cust_status
 219
 220 Given an object that contains fields from cust_main (say, from a JOINed
 221 search; see httemplate/search/ for examples), returns the equivalent of the
 222 FS::cust_main I<ucfirst_status> method, or "(unlinked)" if this object is not
 223 linked to a customer.
 224
 225 =cut
 226
 227 sub ucfirst_cust_status {
 228   carp "ucfirst_cust_status deprecated, use cust_status_label";
 229   local($FS::cust_main::ucfirst_nowarn) = 1;
 230   my $self = shift;
 231   $self->cust_linked
 232     ? ucfirst( $self->cust_status(@_) )
 233     : $self->cust_unlinked_msg;
 234 }
 235
 236 =item cust_status_label
 237
 238 =cut
 239
 240 sub cust_status_label {
 241   my $self = shift;
 242
 243   $self->cust_linked
 244     ? FS::cust_main::cust_status_label($self)
 245     : $self->cust_unlinked_msg;
 246 }
 247
 248 =item cust_statuscolor
 249
 250 Given an object that contains fields from cust_main (say, from a JOINed
 251 search; see httemplate/search/ for examples), returns the equivalent of the
 252 FS::cust_main I<statuscol> method, or "000000" if this object is not linked to
 253 a customer.
 254
 255 =cut
 256
 257 sub cust_statuscolor {
 258   my $self = shift;
 259
 260   $self->cust_linked
 261     ? FS::cust_main::cust_statuscolor($self)
 262     : '000000';
 263 }
 264
 265 =item agent_name
 266
 267 =cut
 268
 269 sub agent_name {
 270   my $self = shift;
 271   $self->cust_linked
 272     ? $self->cust_main->agent_name
 273     : $self->cust_unlinked_msg;
 274 }
 275
 276 =item prospect_sql
 277
 278 =item active_sql
 279
 280 =item inactive_sql
 281
 282 =item suspended_sql
 283
 284 =item cancelled_sql
 285
 286 Class methods that return SQL framents, equivalent to the corresponding
 287 FS::cust_main method.
 288
 289 =cut
 290
 291 #      my \$self = shift;
 292 #      \$self->cust_linked
 293 #        ? FS::cust_main::${sub}_sql(\$self)
 294 #        : '0';
 295
 296 foreach my $sub (qw( prospect active inactive suspended cancelled )) {
 297   eval "
 298     sub ${sub}_sql {
 299       confess 'cust_main_Mixin ${sub}_sql called with object' if ref(\$_[0]);
 300       'cust_main.custnum IS NOT NULL AND '. FS::cust_main->${sub}_sql();
 301     }
 302   ";
 303   die $@ if $@;
 304 }
 305
 306 =item cust_search_sql
 307
 308 Returns a list of SQL WHERE fragments to search for parameters specified
 309 in HASHREF.  Valid parameters are:
 310
 311 =over 4
 312
 313 =item agentnum
 314
 315 =item status
 316
 317 =back
 318
 319 =cut
 320
 321 sub cust_search_sql {
 322   my($class, $param) = @_;
 323
 324   if ( $DEBUG ) {
 325     warn "$me cust_search_sql called with params: \n".
 326          join("\n", map { "  $_: ". $param->{$_} } keys %$param ). "\n";
 327   }
 328
 329   my @search = ();
 330
 331   if ( $param->{'agentnum'} && $param->{'agentnum'} =~ /^(\d+)$/ ) {
 332     push @search, "cust_main.agentnum = $1";
 333   }
 334
 335   #status (prospect active inactive suspended cancelled)
 336   if ( grep { $param->{'status'} eq $_ } FS::cust_main->statuses() ) {
 337     my $method = $param->{'status'}. '_sql';
 338     push @search, $class->$method();
 339   }
 340
 341   #here is the agent virtualization
 342   push @search,
 343     $FS::CurrentUser::CurrentUser->agentnums_sql( 'table' => 'cust_main' );
 344
 345   return @search;
 346
 347 }
 348
 349 =item email_search_result HASHREF
 350
 351 Emails a notice to the specified customer's contact_email addresses.
 352
 353
 354 If the user has specified "Invoice recipients" on the send e-mail screen,
 355 contact_email rows containing the invoice_dest flag will be included.
 356 This option is default, if neither 'invoice' nor 'message' are present.
 357
 358 If the user has specified "Message recipients" on the send e-mail screen,
 359 contact_email rows containing the message_dest flag will be included.
 360
 361 The selection is indicated by the presence of the text 'message' or
 362 'invoice' within the to_contact_classnum argument.
 363
 364
 365 Parameters:
 366
 367 =over 4
 368
 369 =item job
 370
 371 Queue job for status updates.  Required.
 372
 373 =item search
 374
 375 Hashref of params to the L<FS::Record/search> method.  Required.
 376
 377 =item msgnum
 378
 379 Message template number (see L<FS::msg_template>).  Overrides all
 380 of the following options.
 381
 382 =item from
 383
 384 From: address
 385
 386 =item subject
 387
 388 Email Subject:
 389
 390 =item html_body
 391
 392 HTML body
 393
 394 =item text_body
 395
 396 Text body
 397
 398 =item to_contact_classnum
 399
 400 This field contains a comma-separated list.  This list may contain:
 401
 402 - the text "invoice" indicating contacts with invoice_dest flag should
 403   be included
 404 - the text "message" indicating contacts with message_dest flag should
 405   be included
 406 - numbers representing classnum id values for email contact classes.
 407   If any classnum are present, emails should only be sent to contact_email
 408   addresses where contact_email.classnum contains one of these classes.
 409   The classnum 0 also includes where contact_email.classnum IS NULL
 410
 411 If neither 'invoice' nor 'message' has been specified, this method will
 412 behave as if 'invoice' had been selected
 413
 414 =back
 415
 416 Returns an error message, or false for success.
 417
 418 If any messages fail to send, they will be queued as individual
 419 jobs which can be manually retried.  If the first ten messages
 420 in the job fail, the entire job will abort and return an error.
 421
 422 =cut
 423
 424 use Storable qw(thaw);
 425 use MIME::Base64;
 426 use Data::Dumper qw(Dumper);
 427 use Digest::SHA qw(sha1); # for duplicate checking
 428
 429 sub email_search_result {
 430   my($class, $param) = @_;
 431
 432   my $conf = FS::Conf->new;
 433   my $send_to_domain = $conf->config('email-to-voice_domain');
 434
 435   my $msgnum = $param->{msgnum};
 436   my $from = delete $param->{from};
 437   my $subject = delete $param->{subject};
 438   my $html_body = delete $param->{html_body};
 439   my $text_body = delete $param->{text_body};
 440   my $to_contact_classnum = delete $param->{to_contact_classnum};
 441   my $emailtovoice_name = delete $param->{emailtovoice_contact};
 442
 443   my $error = '';
 444
 445   my $to = $emailtovoice_name . '@' . $send_to_domain unless !$emailtovoice_name;
 446
 447   my $job = delete $param->{'job'}
 448     or die "email_search_result must run from the job queue.\n";
 449
 450   my $msg_template;
 451   if ( $msgnum ) {
 452     $msg_template = qsearchs('msg_template', { msgnum => $msgnum } )
 453       or die "msgnum $msgnum not found\n";
 454   } else {
 455     $msg_template = FS::msg_template->new({
 456         from_addr => $from,
 457         msgname   => $subject, # maybe a timestamp also?
 458         disabled  => 'D', # 'D'raft
 459         # msgclass, maybe
 460     });
 461     $error = $msg_template->insert(
 462       subject => $subject,
 463       body    => $html_body,
 464     );
 465     return "$error (when creating draft template)" if $error;
 466   }
 467
 468   my $sql_query = $class->search($param->{'search'});
 469   $sql_query->{'select'} = $sql_query->{'table'} . '.*';
 470
 471   my $count_query   = delete($sql_query->{'count_query'});
 472   my $count_sth = dbh->prepare($count_query)
 473     or die "Error preparing $count_query: ". dbh->errstr;
 474   $count_sth->execute
 475     or die "Error executing $count_query: ". $count_sth->errstr;
 476   my $count_arrayref = $count_sth->fetchrow_arrayref;
 477   my $num_cust = $count_arrayref->[0];
 478
 479   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
 480   my @retry_jobs = ();
 481   my $dups = 0;
 482   my $success = 0;
 483   my %sent_to = ();
 484
 485   if ( !$msg_template ) {
 486     die "email_search_result now requires a msg_template";
 487   }
 488
 489   #eventually order+limit magic to reduce memory use?
 490   foreach my $obj ( qsearch($sql_query) ) {
 491
 492     #progressbar first, so that the count is right
 493     $num++;
 494     if ( time - $min_sec > $last ) {
 495       my $error = $job->update_statustext(
 496         int( 100 * $num / $num_cust )
 497       );
 498       die $error if $error;
 499       $last = time;
 500     }
 501
 502     my $cust_main = $obj->cust_main;
 503     if ( !$cust_main ) {
 504       next; # unlinked object; nothing else we can do
 505     }
 506
 507     my %to = ();
 508     if ($to) { $to{'to'} = $to; }
 509
 510     my $cust_msg = $msg_template->prepare(
 511       'cust_main' => $cust_main,
 512       'object'    => $obj,
 513       'to_contact_classnum' => $to_contact_classnum,
 514       %to,
 515     );
 516
 517     # For non-cust_main searches, we avoid duplicates based on message
 518     # body text.
 519     my $unique = $cust_main->custnum;
 520     $unique .= sha1($cust_msg->text_body) if $class ne 'FS::cust_main';
 521     if( $sent_to{$unique} ) {
 522       # avoid duplicates
 523       $dups++;
 524       next;
 525     }
 526
 527     $sent_to{$unique} = 1;
 528
 529     $error = $cust_msg->send;
 530
 531     if($error) {
 532       # queue the sending of this message so that the user can see what we
 533       # tried to do, and retry if desired
 534       # (note the cust_msg itself also now has a status of 'failed'; that's
 535       # fine, as it will get its status reset if we retry the job)
 536       my $queue = new FS::queue {
 537         'job'        => 'FS::cust_msg::process_send',
 538         'custnum'    => $cust_main->custnum,
 539         'status'     => 'failed',
 540         'statustext' => $error,
 541       };
 542       $queue->insert($cust_msg->custmsgnum);
 543       push @retry_jobs, $queue;
 544     }
 545     else {
 546       $success++;
 547     }
 548
 549     if($success == 0 and
 550         (scalar(@retry_jobs) > 10 or $num == $num_cust)
 551       ) {
 552       # 10 is arbitrary, but if we have enough failures, that's
 553       # probably a configuration or network problem, and we
 554       # abort the batch and run away screaming.
 555       # We NEVER do this if anything was successfully sent.
 556       $_->delete foreach (@retry_jobs);
 557       return "multiple failures: '$error'\n";
 558     }
 559   } # foreach $obj
 560
 561   # if the message template was created as "draft", change its status to
 562   # "completed"
 563   if ($msg_template->disabled eq 'D') {
 564     $msg_template->set('disabled' => 'C');
 565     my $error = $msg_template->replace;
 566     warn "$error (setting draft message template status)" if $error;
 567   }
 568
 569   if(@retry_jobs) {
 570     # fail the job, but with a status message that makes it clear
 571     # something was sent.
 572     return "Sent $success, skipped $dups duplicate(s), failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
 573   }
 574
 575   return '';
 576 }
 577
 578 sub process_email_search_result {
 579   my $job = shift;
 580   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
 581
 582   my $param = shift;
 583   warn Dumper($param) if $DEBUG;
 584
 585   $param->{'job'} = $job;
 586
 587   $param->{'search'} = thaw(decode_base64($param->{'search'}))
 588     or die "process_email_search_result requires search params.\n";
 589
 590   my $table = $param->{'table'}
 591     or die "process_email_search_result requires table.\n";
 592
 593   eval "use FS::$table;";
 594   die "error loading FS::$table: $@\n" if $@;
 595
 596   my $error = "FS::$table"->email_search_result( $param );
 597   dbh->commit; # save failed jobs before rethrowing the error
 598   die $error if $error;
 599
 600 }
 601
 602 sub customer_agent_transfer_search_result {
 603   my($class, $param) = @_;
 604
 605   my $newagentnum = $param->{agentnum};
 606   my $error = '';
 607   my @customers;
 608
 609   my $job = delete $param->{'job'}
 610     or die "customer_agent_transfer_search_result must run from the job queue.\n";
 611
 612   my $list = $param->{'list'};
 613
 614   if ($param->{'search'}) {
 615     my $sql_query = $class->search($param->{'search'});
 616     $sql_query->{'select'} = $sql_query->{'table'} . '.*';
 617     @customers = qsearch($sql_query);
 618   }
 619
 620   @customers = @$list if !@customers && $list;
 621   my $num_cust = scalar(@customers);
 622
 623   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar
 624
 625   # Transactionize
 626   my $oldAutoCommit = $FS::UID::AutoCommit;
 627   local $FS::UID::AutoCommit = 0;
 628   my $dbh = dbh;
 629
 630   foreach my $obj ( @customers ) {
 631
 632     #progressbar first, so that the count is right
 633     $num++;
 634     if ( time - $min_sec > $last ) {
 635       my $error = $job->update_statustext(
 636         int( 100 * $num / $num_cust )
 637       );
 638       die $error if $error;
 639       $last = time;
 640     }
 641
 642     my $cust_main = $obj->cust_main;
 643     if ( !$cust_main ) {
 644       next; # unlinked object nothing to do
 645     }
 646
 647     $cust_main->agentnum($newagentnum);
 648     $error = $cust_main->replace;
 649
 650     if ( $error ) {
 651       $dbh->rollback if $oldAutoCommit;
 652       return "transfering to new agent: $error";
 653     }
 654
 655   } # foreach $obj
 656
 657   $dbh->commit if $oldAutoCommit;
 658   return '';
 659 }
 660
 661 =item process_customer_agent_transfer_search_result
 662
 663 Mass transfers customers to new agent.
 664
 665 Is Transactionized so entire list transfers or none.
 666
 667 excepts either a list of cust_main objects in the base64 encoded cgi param list
 668 or a list of search fields in the base64 encoded  cgi param search.
 669
 670 =cut
 671
 672 sub process_customer_agent_transfer_search_result {
 673   my $job = shift;
 674
 675   my $param = shift;
 676   warn Dumper($param) if $DEBUG;
 677
 678   $param->{'job'} = $job;
 679
 680   $param->{'search'} = thaw(decode_base64($param->{'search'}))
 681     or die "process_customer_agent_transfer_search_result.\n" if $param->{'search'};
 682
 683   $param->{'list'} = thaw(decode_base64($param->{'list'}))
 684     or die "process_customer_agent_transfer_search_result.\n" if $param->{'list'};;
 685
 686   my $table = $param->{'table'}
 687     or die "process_customer_agent_transfer_search_result.\n";
 688
 689   eval "use FS::$table;";
 690   die "error loading FS::$table: $@\n" if $@;
 691
 692   my $error = "FS::$table"->customer_agent_transfer_search_result( $param );
 693
 694   die $error if $error;
 695
 696 }
 697
 698 =item conf
 699
 700 Returns a configuration handle (L<FS::Conf>) set to the customer's locale,
 701 if they have one.  If not, returns an FS::Conf with no locale.
 702
 703 =cut
 704
 705 sub conf {
 706   my $self = shift;
 707   return $self->{_conf} if (ref $self and $self->{_conf});
 708   my $cust_main = $self->cust_main;
 709   my $conf = new FS::Conf {
 710     'locale' => ($cust_main ? $cust_main->locale : '')
 711   };
 712   $self->{_conf} = $conf if ref $self;
 713   return $conf;
 714 }
 715
 716 =item mt TEXT [, ARGS ]
 717
 718 Localizes a text string (see L<Locale::Maketext>) for the customer's locale,
 719 if they have one.
 720
 721 =cut
 722
 723 sub mt {
 724   my $self = shift;
 725   return $self->{_lh}->maketext(@_) if (ref $self and $self->{_lh});
 726   my $cust_main = $self->cust_main;
 727   my $locale = $cust_main ? $cust_main->locale : '';
 728   my $lh = FS::L10N->get_handle($locale);
 729   $self->{_lh} = $lh if ref $self;
 730   return $lh->maketext(@_);
 731 }
 732
 733 =item time2str_local FORMAT, TIME[, ESCAPE]
 734
 735 Localizes a date (see L<Date::Language>) for the customer's locale.
 736
 737 FORMAT can be a L<Date::Format> string, or one of these special words:
 738
 739 - "short": the value of the "date_format" config setting for the customer's
 740   locale, defaulting to "%x".
 741 - "rdate": the same as "short" except that the default has a four-digit year.
 742 - "long": the value of the "date_format_long" config setting for the
 743   customer's locale, defaulting to "%b %o, %Y".
 744
 745 ESCAPE, if specified, is one of "latex" or "html", and will escape non-ASCII
 746 characters and convert spaces to nonbreaking spaces.
 747
 748 =cut
 749
 750 sub time2str_local {
 751   # renamed so that we don't have to change every single reference to
 752   # time2str everywhere
 753   my $self = shift;
 754   my ($format, $time, $escape) = @_;
 755   return '' unless $time > 0; # work around time2str's traditional stupidity
 756
 757   $self->{_date_format} ||= {};
 758   if (!exists($self->{_dh})) {
 759     my $locale = $self->cust_main->locale if $self->cust_main;
 760     $locale ||= FS::Conf->new->config('locale') || 'en_US';
 761
 762     my %info = FS::Locales->locale_info($locale);
 763
 764     $self->{_dh} = eval { Date::Language->new($info{'name'}) }
 765       || Date::Language->new(); # fall back to English
 766   }
 767
 768   if ($format eq 'short') {
 769     $format = $self->{_date_format}->{short}
 770             ||= $self->conf->config('date_format') || '%x';
 771   } elsif ($format eq 'rdate') {
 772     $format = $self->{_date_format}->{rdate}
 773             ||= $self->conf->config('date_format') || '%m/%d/%Y';
 774   } elsif ($format eq 'long') {
 775     $format = $self->{_date_format}->{long}
 776             ||= $self->conf->config('date_format_long') || '%b %o, %Y';
 777   }
 778
 779   # actually render the date
 780   my $string = $self->{_dh}->time2str($format, $time);
 781
 782   if ($escape) {
 783     if ($escape eq 'html') {
 784       $string = encode_entities($string);
 785       $string =~ s/ +/&nbsp;/g;
 786     } elsif ($escape eq 'latex') { # just do nbsp's here
 787       $string =~ s/ +/~/g;
 788     }
 789   }
 790
 791   $string;
 792 }
 793
 794 =item unsuspend_balance
 795
 796 If conf I<unsuspend_balance> is set and customer's current balance is
 797 beneath the set threshold, unsuspends customer packages.
 798
 799 =cut
 800
 801 sub unsuspend_balance {
 802   my $self = shift;
 803   my $cust_main = $self->cust_main;
 804   my $conf = $self->conf;
 805   my $setting = $conf->config('unsuspend_balance') or return;
 806   my $maxbalance;
 807   if ($setting eq 'Zero') {
 808     $maxbalance = 0;
 809
 810   # kind of a pain to load/check all cust_bill instead of just open ones,
 811   # but if for some reason payment gets applied to later bills before
 812   # earlier ones, we still want to consider the later ones as allowable balance
 813   } elsif ($setting eq 'Latest invoice charges') {
 814     my @cust_bill = $cust_main->cust_bill();
 815     my $cust_bill = $cust_bill[-1]; #always want the most recent one
 816     if ($cust_bill) {
 817       $maxbalance = $cust_bill->charged || 0;
 818     } else {
 819       $maxbalance = 0;
 820     }
 821   } elsif ($setting eq 'Charges not past due') {
 822     my $now = time;
 823     $maxbalance = 0;
 824     foreach my $cust_bill ($cust_main->cust_bill()) {
 825       next unless $now <= ($cust_bill->due_date || $cust_bill->_date);
 826       $maxbalance += $cust_bill->charged || 0;
 827     }
 828   } elsif (length($setting)) {
 829     warn "Unrecognized unsuspend_balance setting $setting";
 830     return;
 831   } else {
 832     return;
 833   }
 834   my $balance = $cust_main->balance || 0;
 835   if ($balance <= $maxbalance) {
 836     my @errors = $cust_main->unsuspend(
 837                    'reason_type' => $conf->config('unsuspend_reason_type')
 838                  );
 839
 840     push @errors, $cust_main->release_hold if $conf->exists('unsuspend-unhold');
 841     # side-fx with nested transactions?  upstack rolls back?
 842     warn "WARNING:Errors unsuspending customer ". $cust_main->custnum. ": ".
 843          join(' / ', @errors)
 844       if @errors;
 845   }
 846   return;
 847 }
 848
 849 =back
 850
 851 =head1 BUGS
 852
 853 =head1 SEE ALSO
 854
 855 L<FS::cust_main>, L<FS::Record>
 856
 857 =cut
 858
 859 1;