FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 require 5.006;
   4 use strict;
   5 use base qw( FS::otaker_Mixin FS::payinfo_Mixin FS::Record );
   6 use vars qw( @EXPORT_OK $DEBUG $me $conf
   7              @encrypted_fields
   8              $import $ignore_expired_card
   9              $skip_fuzzyfiles @fuzzyfields
  10              @paytypes
  11            );
  12 use vars qw( $realtime_bop_decline_quiet ); #ugh
  13 use Safe;
  14 use Carp;
  15 use Exporter;
  16 use Scalar::Util qw( blessed );
  17 use List::Util qw( min );
  18 use Time::Local qw(timelocal);
  19 use Storable qw(thaw);
  20 use MIME::Base64;
  21 use Data::Dumper;
  22 use Tie::IxHash;
  23 use Digest::MD5 qw(md5_base64);
  24 use Date::Format;
  25 #use Date::Manip;
  26 use File::Temp qw( tempfile );
  27 use String::Approx qw(amatch);
  28 use Business::CreditCard 0.28;
  29 use Locale::Country;
  30 use FS::UID qw( getotaker dbh driver_name );
  31 use FS::Record qw( qsearchs qsearch dbdef regexp_sql );
  32 use FS::Misc qw( generate_email send_email generate_ps do_print );
  33 use FS::Msgcat qw(gettext);
  34 use FS::payby;
  35 use FS::cust_pkg;
  36 use FS::cust_svc;
  37 use FS::cust_bill;
  38 use FS::cust_bill_pkg;
  39 use FS::cust_bill_pkg_display;
  40 use FS::cust_bill_pkg_tax_location;
  41 use FS::cust_bill_pkg_tax_rate_location;
  42 use FS::cust_pay;
  43 use FS::cust_pay_pending;
  44 use FS::cust_pay_void;
  45 use FS::cust_pay_batch;
  46 use FS::cust_credit;
  47 use FS::cust_refund;
  48 use FS::part_referral;
  49 use FS::cust_main_county;
  50 use FS::cust_location;
  51 use FS::cust_class;
  52 use FS::cust_main_exemption;
  53 use FS::cust_tax_adjustment;
  54 use FS::tax_rate;
  55 use FS::tax_rate_location;
  56 use FS::cust_tax_location;
  57 use FS::part_pkg_taxrate;
  58 use FS::agent;
  59 use FS::cust_main_invoice;
  60 use FS::cust_tag;
  61 use FS::cust_credit_bill;
  62 use FS::cust_bill_pay;
  63 use FS::prepay_credit;
  64 use FS::queue;
  65 use FS::part_pkg;
  66 use FS::part_event;
  67 use FS::part_event_condition;
  68 use FS::part_export;
  69 #use FS::cust_event;
  70 use FS::type_pkgs;
  71 use FS::payment_gateway;
  72 use FS::agent_payment_gateway;
  73 use FS::banned_pay;
  74 use FS::TicketSystem;
  75
  76 @EXPORT_OK = qw( smart_search );
  77
  78 $realtime_bop_decline_quiet = 0;
  79
  80 # 1 is mostly method/subroutine entry and options
  81 # 2 traces progress of some operations
  82 # 3 is even more information including possibly sensitive data
  83 $DEBUG = 0;
  84 $me = '[FS::cust_main]';
  85
  86 $import = 0;
  87 $ignore_expired_card = 0;
  88
  89 $skip_fuzzyfiles = 0;
  90 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
  91
  92 @encrypted_fields = ('payinfo', 'paycvv');
  93 sub nohistory_fields { ('payinfo', 'paycvv'); }
  94
  95 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
  96
  97 #ask FS::UID to run this stuff for us later
  98 #$FS::UID::callback{'FS::cust_main'} = sub {
  99 install_callback FS::UID sub {
 100   $conf = new FS::Conf;
 101   #yes, need it for stuff below (prolly should be cached)
 102 };
 103
 104 sub _cache {
 105   my $self = shift;
 106   my ( $hashref, $cache ) = @_;
 107   if ( exists $hashref->{'pkgnum'} ) {
 108     #@{ $self->{'_pkgnum'} } = ();
 109     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
 110     $self->{'_pkgnum'} = $subcache;
 111     #push @{ $self->{'_pkgnum'} },
 112     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
 113   }
 114 }
 115
 116 =head1 NAME
 117
 118 FS::cust_main - Object methods for cust_main records
 119
 120 =head1 SYNOPSIS
 121
 122   use FS::cust_main;
 123
 124   $record = new FS::cust_main \%hash;
 125   $record = new FS::cust_main { 'column' => 'value' };
 126
 127   $error = $record->insert;
 128
 129   $error = $new_record->replace($old_record);
 130
 131   $error = $record->delete;
 132
 133   $error = $record->check;
 134
 135   @cust_pkg = $record->all_pkgs;
 136
 137   @cust_pkg = $record->ncancelled_pkgs;
 138
 139   @cust_pkg = $record->suspended_pkgs;
 140
 141   $error = $record->bill;
 142   $error = $record->bill %options;
 143   $error = $record->bill 'time' => $time;
 144
 145   $error = $record->collect;
 146   $error = $record->collect %options;
 147   $error = $record->collect 'invoice_time'   => $time,
 148                           ;
 149
 150 =head1 DESCRIPTION
 151
 152 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 153 FS::Record.  The following fields are currently supported:
 154
 155 =over 4
 156
 157 =item custnum
 158
 159 Primary key (assigned automatically for new customers)
 160
 161 =item agentnum
 162
 163 Agent (see L<FS::agent>)
 164
 165 =item refnum
 166
 167 Advertising source (see L<FS::part_referral>)
 168
 169 =item first
 170
 171 First name
 172
 173 =item last
 174
 175 Last name
 176
 177 =item ss
 178
 179 Cocial security number (optional)
 180
 181 =item company
 182
 183 (optional)
 184
 185 =item address1
 186
 187 =item address2
 188
 189 (optional)
 190
 191 =item city
 192
 193 =item county
 194
 195 (optional, see L<FS::cust_main_county>)
 196
 197 =item state
 198
 199 (see L<FS::cust_main_county>)
 200
 201 =item zip
 202
 203 =item country
 204
 205 (see L<FS::cust_main_county>)
 206
 207 =item daytime
 208
 209 phone (optional)
 210
 211 =item night
 212
 213 phone (optional)
 214
 215 =item fax
 216
 217 phone (optional)
 218
 219 =item ship_first
 220
 221 Shipping first name
 222
 223 =item ship_last
 224
 225 Shipping last name
 226
 227 =item ship_company
 228
 229 (optional)
 230
 231 =item ship_address1
 232
 233 =item ship_address2
 234
 235 (optional)
 236
 237 =item ship_city
 238
 239 =item ship_county
 240
 241 (optional, see L<FS::cust_main_county>)
 242
 243 =item ship_state
 244
 245 (see L<FS::cust_main_county>)
 246
 247 =item ship_zip
 248
 249 =item ship_country
 250
 251 (see L<FS::cust_main_county>)
 252
 253 =item ship_daytime
 254
 255 phone (optional)
 256
 257 =item ship_night
 258
 259 phone (optional)
 260
 261 =item ship_fax
 262
 263 phone (optional)
 264
 265 =item payby
 266
 267 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
 268
 269 =item payinfo
 270
 271 Payment Information (See L<FS::payinfo_Mixin> for data format)
 272
 273 =item paymask
 274
 275 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
 276
 277 =item paycvv
 278
 279 Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card
 280
 281 =item paydate
 282
 283 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 284
 285 =item paystart_month
 286
 287 Start date month (maestro/solo cards only)
 288
 289 =item paystart_year
 290
 291 Start date year (maestro/solo cards only)
 292
 293 =item payissue
 294
 295 Issue number (maestro/solo cards only)
 296
 297 =item payname
 298
 299 Name on card or billing name
 300
 301 =item payip
 302
 303 IP address from which payment information was received
 304
 305 =item tax
 306
 307 Tax exempt, empty or `Y'
 308
 309 =item usernum
 310
 311 Order taker (see L<FS::access_user>)
 312
 313 =item comments
 314
 315 Comments (optional)
 316
 317 =item referral_custnum
 318
 319 Referring customer number
 320
 321 =item spool_cdr
 322
 323 Enable individual CDR spooling, empty or `Y'
 324
 325 =item dundate
 326
 327 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
 328
 329 =item squelch_cdr
 330
 331 Discourage individual CDR printing, empty or `Y'
 332
 333 =back
 334
 335 =head1 METHODS
 336
 337 =over 4
 338
 339 =item new HASHREF
 340
 341 Creates a new customer.  To add the customer to the database, see L<"insert">.
 342
 343 Note that this stores the hash reference, not a distinct copy of the hash it
 344 points to.  You can ask the object for a copy with the I<hash> method.
 345
 346 =cut
 347
 348 sub table { 'cust_main'; }
 349
 350 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 351
 352 Adds this customer to the database.  If there is an error, returns the error,
 353 otherwise returns false.
 354
 355 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 356 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 357 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 358 hash reference is equivalent to not supplying this parameter.  There should be
 359 a better explanation of this, but until then, here's an example:
 360
 361   use Tie::RefHash;
 362   tie %hash, 'Tie::RefHash'; #this part is important
 363   %hash = (
 364     $cust_pkg => [ $svc_acct ],
 365     ...
 366   );
 367   $cust_main->insert( \%hash );
 368
 369 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 370 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 371 expected and rollback the entire transaction; it is not necessary to call
 372 check_invoicing_list first.  The invoicing_list is set after the records in the
 373 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 374 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 375
 376   $cust_main->insert( {}, [ $email, 'POST' ] );
 377
 378 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
 379
 380 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 381 on the supplied jobnum (they will not run until the specific job completes).
 382 This can be used to defer provisioning until some action completes (such
 383 as running the customer's credit card successfully).
 384
 385 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 386 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 387 the B<reexport> method.)
 388
 389 The I<tax_exemption> option can be set to an arrayref of tax names.
 390 FS::cust_main_exemption records will be created and inserted.
 391
 392 =cut
 393
 394 sub insert {
 395   my $self = shift;
 396   my $cust_pkgs = @_ ? shift : {};
 397   my $invoicing_list = @_ ? shift : '';
 398   my %options = @_;
 399   warn "$me insert called with options ".
 400        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 401     if $DEBUG;
 402
 403   local $SIG{HUP} = 'IGNORE';
 404   local $SIG{INT} = 'IGNORE';
 405   local $SIG{QUIT} = 'IGNORE';
 406   local $SIG{TERM} = 'IGNORE';
 407   local $SIG{TSTP} = 'IGNORE';
 408   local $SIG{PIPE} = 'IGNORE';
 409
 410   my $oldAutoCommit = $FS::UID::AutoCommit;
 411   local $FS::UID::AutoCommit = 0;
 412   my $dbh = dbh;
 413
 414   my $prepay_identifier = '';
 415   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
 416   my $payby = '';
 417   if ( $self->payby eq 'PREPAY' ) {
 418
 419     $self->payby('BILL');
 420     $prepay_identifier = $self->payinfo;
 421     $self->payinfo('');
 422
 423     warn "  looking up prepaid card $prepay_identifier\n"
 424       if $DEBUG > 1;
 425
 426     my $error = $self->get_prepay( $prepay_identifier,
 427                                    'amount_ref'     => \$amount,
 428                                    'seconds_ref'    => \$seconds,
 429                                    'upbytes_ref'    => \$upbytes,
 430                                    'downbytes_ref'  => \$downbytes,
 431                                    'totalbytes_ref' => \$totalbytes,
 432                                  );
 433     if ( $error ) {
 434       $dbh->rollback if $oldAutoCommit;
 435       #return "error applying prepaid card (transaction rolled back): $error";
 436       return $error;
 437     }
 438
 439     $payby = 'PREP' if $amount;
 440
 441   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
 442
 443     $payby = $1;
 444     $self->payby('BILL');
 445     $amount = $self->paid;
 446
 447   }
 448
 449   warn "  inserting $self\n"
 450     if $DEBUG > 1;
 451
 452   $self->signupdate(time) unless $self->signupdate;
 453
 454   $self->auto_agent_custid()
 455     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
 456
 457   my $error = $self->SUPER::insert;
 458   if ( $error ) {
 459     $dbh->rollback if $oldAutoCommit;
 460     #return "inserting cust_main record (transaction rolled back): $error";
 461     return $error;
 462   }
 463
 464   warn "  setting invoicing list\n"
 465     if $DEBUG > 1;
 466
 467   if ( $invoicing_list ) {
 468     $error = $self->check_invoicing_list( $invoicing_list );
 469     if ( $error ) {
 470       $dbh->rollback if $oldAutoCommit;
 471       #return "checking invoicing_list (transaction rolled back): $error";
 472       return $error;
 473     }
 474     $self->invoicing_list( $invoicing_list );
 475   }
 476
 477   warn "  setting customer tags\n"
 478     if $DEBUG > 1;
 479
 480   foreach my $tagnum ( @{ $self->tagnum || [] } ) {
 481     my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
 482                                       'custnum' => $self->custnum };
 483     my $error = $cust_tag->insert;
 484     if ( $error ) {
 485       $dbh->rollback if $oldAutoCommit;
 486       return $error;
 487     }
 488   }
 489
 490   if ( $invoicing_list ) {
 491     $error = $self->check_invoicing_list( $invoicing_list );
 492     if ( $error ) {
 493       $dbh->rollback if $oldAutoCommit;
 494       #return "checking invoicing_list (transaction rolled back): $error";
 495       return $error;
 496     }
 497     $self->invoicing_list( $invoicing_list );
 498   }
 499
 500
 501   warn "  setting cust_main_exemption\n"
 502     if $DEBUG > 1;
 503
 504   my $tax_exemption = delete $options{'tax_exemption'};
 505   if ( $tax_exemption ) {
 506     foreach my $taxname ( @$tax_exemption ) {
 507       my $cust_main_exemption = new FS::cust_main_exemption {
 508         'custnum' => $self->custnum,
 509         'taxname' => $taxname,
 510       };
 511       my $error = $cust_main_exemption->insert;
 512       if ( $error ) {
 513         $dbh->rollback if $oldAutoCommit;
 514         return "inserting cust_main_exemption (transaction rolled back): $error";
 515       }
 516     }
 517   }
 518
 519   if (    $conf->config('cust_main-skeleton_tables')
 520        && $conf->config('cust_main-skeleton_custnum') ) {
 521
 522     warn "  inserting skeleton records\n"
 523       if $DEBUG > 1;
 524
 525     my $error = $self->start_copy_skel;
 526     if ( $error ) {
 527       $dbh->rollback if $oldAutoCommit;
 528       return $error;
 529     }
 530
 531   }
 532
 533   warn "  ordering packages\n"
 534     if $DEBUG > 1;
 535
 536   $error = $self->order_pkgs( $cust_pkgs,
 537                               %options,
 538                               'seconds_ref'    => \$seconds,
 539                               'upbytes_ref'    => \$upbytes,
 540                               'downbytes_ref'  => \$downbytes,
 541                               'totalbytes_ref' => \$totalbytes,
 542                             );
 543   if ( $error ) {
 544     $dbh->rollback if $oldAutoCommit;
 545     return $error;
 546   }
 547
 548   if ( $seconds ) {
 549     $dbh->rollback if $oldAutoCommit;
 550     return "No svc_acct record to apply pre-paid time";
 551   }
 552   if ( $upbytes || $downbytes || $totalbytes ) {
 553     $dbh->rollback if $oldAutoCommit;
 554     return "No svc_acct record to apply pre-paid data";
 555   }
 556
 557   if ( $amount ) {
 558     warn "  inserting initial $payby payment of $amount\n"
 559       if $DEBUG > 1;
 560     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 561     if ( $error ) {
 562       $dbh->rollback if $oldAutoCommit;
 563       return "inserting payment (transaction rolled back): $error";
 564     }
 565   }
 566
 567   unless ( $import || $skip_fuzzyfiles ) {
 568     warn "  queueing fuzzyfiles update\n"
 569       if $DEBUG > 1;
 570     $error = $self->queue_fuzzyfiles_update;
 571     if ( $error ) {
 572       $dbh->rollback if $oldAutoCommit;
 573       return "updating fuzzy search cache: $error";
 574     }
 575   }
 576
 577   # cust_main exports!
 578   warn "  exporting\n" if $DEBUG > 1;
 579
 580   my $export_args = $options{'export_args'} || [];
 581
 582   my @part_export =
 583     map qsearch( 'part_export', {exportnum=>$_} ),
 584       $conf->config('cust_main-exports'); #, $agentnum
 585
 586   foreach my $part_export ( @part_export ) {
 587     my $error = $part_export->export_insert($self, @$export_args);
 588     if ( $error ) {
 589       $dbh->rollback if $oldAutoCommit;
 590       return "exporting to ". $part_export->exporttype.
 591              " (transaction rolled back): $error";
 592     }
 593   }
 594
 595   #foreach my $depend_jobnum ( @$depend_jobnums ) {
 596   #    warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 597   #      if $DEBUG;
 598   #    foreach my $jobnum ( @jobnums ) {
 599   #      my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 600   #      warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 601   #        if $DEBUG;
 602   #      my $error = $queue->depend_insert($depend_jobnum);
 603   #      if ( $error ) {
 604   #        $dbh->rollback if $oldAutoCommit;
 605   #        return "error queuing job dependancy: $error";
 606   #      }
 607   #    }
 608   #  }
 609   #
 610   #}
 611   #
 612   #if ( exists $options{'jobnums'} ) {
 613   #  push @{ $options{'jobnums'} }, @jobnums;
 614   #}
 615
 616   warn "  insert complete; committing transaction\n"
 617     if $DEBUG > 1;
 618
 619   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 620   '';
 621
 622 }
 623
 624 use File::CounterFile;
 625 sub auto_agent_custid {
 626   my $self = shift;
 627
 628   my $format = $conf->config('cust_main-auto_agent_custid');
 629   my $agent_custid;
 630   if ( $format eq '1YMMXXXXXXXX' ) {
 631
 632     my $counter = new File::CounterFile 'cust_main.agent_custid';
 633     $counter->lock;
 634
 635     my $ym = 100000000000 + time2str('%y%m00000000', time);
 636     if ( $ym > $counter->value ) {
 637       $counter->{'value'} = $agent_custid = $ym;
 638       $counter->{'updated'} = 1;
 639     } else {
 640       $agent_custid = $counter->inc;
 641     }
 642
 643     $counter->unlock;
 644
 645   } else {
 646     die "Unknown cust_main-auto_agent_custid format: $format";
 647   }
 648
 649   $self->agent_custid($agent_custid);
 650
 651 }
 652
 653 sub start_copy_skel {
 654   my $self = shift;
 655
 656   #'mg_user_preference' => {},
 657   #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
 658   #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
 659   #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
 660   #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
 661   my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
 662   die $@ if $@;
 663
 664   _copy_skel( 'cust_main',                                 #tablename
 665               $conf->config('cust_main-skeleton_custnum'), #sourceid
 666               $self->custnum,                              #destid
 667               @tables,                                     #child tables
 668             );
 669 }
 670
 671 #recursive subroutine, not a method
 672 sub _copy_skel {
 673   my( $table, $sourceid, $destid, %child_tables ) = @_;
 674
 675   my $primary_key;
 676   if ( $table =~ /^(\w+)\.(\w+)$/ ) {
 677     ( $table, $primary_key ) = ( $1, $2 );
 678   } else {
 679     my $dbdef_table = dbdef->table($table);
 680     $primary_key = $dbdef_table->primary_key
 681       or return "$table has no primary key".
 682                 " (or do you need to run dbdef-create?)";
 683   }
 684
 685   warn "  _copy_skel: $table.$primary_key $sourceid to $destid for ".
 686        join (', ', keys %child_tables). "\n"
 687     if $DEBUG > 2;
 688
 689   foreach my $child_table_def ( keys %child_tables ) {
 690
 691     my $child_table;
 692     my $child_pkey = '';
 693     if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
 694       ( $child_table, $child_pkey ) = ( $1, $2 );
 695     } else {
 696       $child_table = $child_table_def;
 697
 698       $child_pkey = dbdef->table($child_table)->primary_key;
 699       #  or return "$table has no primary key".
 700       #            " (or do you need to run dbdef-create?)\n";
 701     }
 702
 703     my $sequence = '';
 704     if ( keys %{ $child_tables{$child_table_def} } ) {
 705
 706       return "$child_table has no primary key".
 707              " (run dbdef-create or try specifying it?)\n"
 708         unless $child_pkey;
 709
 710       #false laziness w/Record::insert and only works on Pg
 711       #refactor the proper last-inserted-id stuff out of Record::insert if this
 712       # ever gets use for anything besides a quick kludge for one customer
 713       my $default = dbdef->table($child_table)->column($child_pkey)->default;
 714       $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
 715         or return "can't parse $child_table.$child_pkey default value ".
 716                   " for sequence name: $default";
 717       $sequence = $1;
 718
 719     }
 720
 721     my @sel_columns = grep { $_ ne $primary_key }
 722                            dbdef->table($child_table)->columns;
 723     my $sel_columns = join(', ', @sel_columns );
 724
 725     my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
 726     my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
 727     my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
 728
 729     my $sel_st = "SELECT $sel_columns FROM $child_table".
 730                  " WHERE $primary_key = $sourceid";
 731     warn "    $sel_st\n"
 732       if $DEBUG > 2;
 733     my $sel_sth = dbh->prepare( $sel_st )
 734       or return dbh->errstr;
 735
 736     $sel_sth->execute or return $sel_sth->errstr;
 737
 738     while ( my $row = $sel_sth->fetchrow_hashref ) {
 739
 740       warn "    selected row: ".
 741            join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
 742         if $DEBUG > 2;
 743
 744       my $statement =
 745         "INSERT INTO $child_table $ins_columns VALUES $placeholders";
 746       my $ins_sth =dbh->prepare($statement)
 747           or return dbh->errstr;
 748       my @param = ( $destid, map $row->{$_}, @ins_columns );
 749       warn "    $statement: [ ". join(', ', @param). " ]\n"
 750         if $DEBUG > 2;
 751       $ins_sth->execute( @param )
 752         or return $ins_sth->errstr;
 753
 754       #next unless keys %{ $child_tables{$child_table} };
 755       next unless $sequence;
 756
 757       #another section of that laziness
 758       my $seq_sql = "SELECT currval('$sequence')";
 759       my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
 760       $seq_sth->execute or return $seq_sth->errstr;
 761       my $insertid = $seq_sth->fetchrow_arrayref->[0];
 762
 763       # don't drink soap!  recurse!  recurse!  okay!
 764       my $error =
 765         _copy_skel( $child_table_def,
 766                     $row->{$child_pkey}, #sourceid
 767                     $insertid, #destid
 768                     %{ $child_tables{$child_table_def} },
 769                   );
 770       return $error if $error;
 771
 772     }
 773
 774   }
 775
 776   return '';
 777
 778 }
 779
 780 =item order_pkg HASHREF | OPTION => VALUE ...
 781
 782 Orders a single package.
 783
 784 Options may be passed as a list of key/value pairs or as a hash reference.
 785 Options are:
 786
 787 =over 4
 788
 789 =item cust_pkg
 790
 791 FS::cust_pkg object
 792
 793 =item cust_location
 794
 795 Optional FS::cust_location object
 796
 797 =item svcs
 798
 799 Optional arryaref of FS::svc_* service objects.
 800
 801 =item depend_jobnum
 802
 803 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
 804 jobs will have a dependancy on the supplied job (they will not run until the
 805 specific job completes).  This can be used to defer provisioning until some
 806 action completes (such as running the customer's credit card successfully).
 807
 808 =item ticket_subject
 809
 810 Optional subject for a ticket created and attached to this customer
 811
 812 =item ticket_subject
 813
 814 Optional queue name for ticket additions
 815
 816 =back
 817
 818 =cut
 819
 820 sub order_pkg {
 821   my $self = shift;
 822   my $opt = ref($_[0]) ? shift : { @_ };
 823
 824   warn "$me order_pkg called with options ".
 825        join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
 826     if $DEBUG;
 827
 828   my $cust_pkg = $opt->{'cust_pkg'};
 829   my $svcs     = $opt->{'svcs'} || [];
 830
 831   my %svc_options = ();
 832   $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
 833     if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
 834
 835   my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
 836                           qw( ticket_subject ticket_queue );
 837
 838   local $SIG{HUP} = 'IGNORE';
 839   local $SIG{INT} = 'IGNORE';
 840   local $SIG{QUIT} = 'IGNORE';
 841   local $SIG{TERM} = 'IGNORE';
 842   local $SIG{TSTP} = 'IGNORE';
 843   local $SIG{PIPE} = 'IGNORE';
 844
 845   my $oldAutoCommit = $FS::UID::AutoCommit;
 846   local $FS::UID::AutoCommit = 0;
 847   my $dbh = dbh;
 848
 849   if ( $opt->{'cust_location'} &&
 850        ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
 851     my $error = $opt->{'cust_location'}->insert;
 852     if ( $error ) {
 853       $dbh->rollback if $oldAutoCommit;
 854       return "inserting cust_location (transaction rolled back): $error";
 855     }
 856     $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
 857   }
 858
 859   $cust_pkg->custnum( $self->custnum );
 860
 861   my $error = $cust_pkg->insert( %insert_params );
 862   if ( $error ) {
 863     $dbh->rollback if $oldAutoCommit;
 864     return "inserting cust_pkg (transaction rolled back): $error";
 865   }
 866
 867   foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
 868     if ( $svc_something->svcnum ) {
 869       my $old_cust_svc = $svc_something->cust_svc;
 870       my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 871       $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 872       $error = $new_cust_svc->replace($old_cust_svc);
 873     } else {
 874       $svc_something->pkgnum( $cust_pkg->pkgnum );
 875       if ( $svc_something->isa('FS::svc_acct') ) {
 876         foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
 877                        qw( seconds upbytes downbytes totalbytes )      ) {
 878           $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
 879           ${ $opt->{$_.'_ref'} } = 0;
 880         }
 881       }
 882       $error = $svc_something->insert(%svc_options);
 883     }
 884     if ( $error ) {
 885       $dbh->rollback if $oldAutoCommit;
 886       return "inserting svc_ (transaction rolled back): $error";
 887     }
 888   }
 889
 890   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 891   ''; #no error
 892
 893 }
 894
 895 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
 896 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
 897
 898 Like the insert method on an existing record, this method orders multiple
 899 packages and included services atomicaly.  Pass a Tie::RefHash data structure
 900 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
 901 There should be a better explanation of this, but until then, here's an
 902 example:
 903
 904   use Tie::RefHash;
 905   tie %hash, 'Tie::RefHash'; #this part is important
 906   %hash = (
 907     $cust_pkg => [ $svc_acct ],
 908     ...
 909   );
 910   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
 911
 912 Services can be new, in which case they are inserted, or existing unaudited
 913 services, in which case they are linked to the newly-created package.
 914
 915 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
 916 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
 917
 918 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 919 on the supplied jobnum (they will not run until the specific job completes).
 920 This can be used to defer provisioning until some action completes (such
 921 as running the customer's credit card successfully).
 922
 923 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 924 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 925 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 926 on the cust_main object is not recommended, as existing services will also be
 927 reexported.)
 928
 929 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
 930 provided, the scalars (provided by references) will be incremented by the
 931 values of the prepaid card.`
 932
 933 =cut
 934
 935 sub order_pkgs {
 936   my $self = shift;
 937   my $cust_pkgs = shift;
 938   my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
 939   my %options = @_;
 940   $seconds_ref ||= $options{'seconds_ref'};
 941
 942   warn "$me order_pkgs called with options ".
 943        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 944     if $DEBUG;
 945
 946   local $SIG{HUP} = 'IGNORE';
 947   local $SIG{INT} = 'IGNORE';
 948   local $SIG{QUIT} = 'IGNORE';
 949   local $SIG{TERM} = 'IGNORE';
 950   local $SIG{TSTP} = 'IGNORE';
 951   local $SIG{PIPE} = 'IGNORE';
 952
 953   my $oldAutoCommit = $FS::UID::AutoCommit;
 954   local $FS::UID::AutoCommit = 0;
 955   my $dbh = dbh;
 956
 957   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 958
 959   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 960
 961     my $error = $self->order_pkg(
 962       'cust_pkg'     => $cust_pkg,
 963       'svcs'         => $cust_pkgs->{$cust_pkg},
 964       'seconds_ref'  => $seconds_ref,
 965       map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
 966                                      depend_jobnum
 967                                    )
 968     );
 969     if ( $error ) {
 970       $dbh->rollback if $oldAutoCommit;
 971       return $error;
 972     }
 973
 974   }
 975
 976   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 977   ''; #no error
 978 }
 979
 980 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
 981
 982 Recharges this (existing) customer with the specified prepaid card (see
 983 L<FS::prepay_credit>), specified either by I<identifier> or as an
 984 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 985 returns false.
 986
 987 Optionally, five scalar references can be passed as well.  They will have their
 988 values filled in with the amount, number of seconds, and number of upload,
 989 download, and total bytes applied by this prepaid card.
 990
 991 =cut
 992
 993 #the ref bullshit here should be refactored like get_prepay.  MyAccount.pm is
 994 #the only place that uses these args
 995 sub recharge_prepay {
 996   my( $self, $prepay_credit, $amountref, $secondsref,
 997       $upbytesref, $downbytesref, $totalbytesref ) = @_;
 998
 999   local $SIG{HUP} = 'IGNORE';
1000   local $SIG{INT} = 'IGNORE';
1001   local $SIG{QUIT} = 'IGNORE';
1002   local $SIG{TERM} = 'IGNORE';
1003   local $SIG{TSTP} = 'IGNORE';
1004   local $SIG{PIPE} = 'IGNORE';
1005
1006   my $oldAutoCommit = $FS::UID::AutoCommit;
1007   local $FS::UID::AutoCommit = 0;
1008   my $dbh = dbh;
1009
1010   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
1011
1012   my $error = $self->get_prepay( $prepay_credit,
1013                                  'amount_ref'     => \$amount,
1014                                  'seconds_ref'    => \$seconds,
1015                                  'upbytes_ref'    => \$upbytes,
1016                                  'downbytes_ref'  => \$downbytes,
1017                                  'totalbytes_ref' => \$totalbytes,
1018                                )
1019            || $self->increment_seconds($seconds)
1020            || $self->increment_upbytes($upbytes)
1021            || $self->increment_downbytes($downbytes)
1022            || $self->increment_totalbytes($totalbytes)
1023            || $self->insert_cust_pay_prepay( $amount,
1024                                              ref($prepay_credit)
1025                                                ? $prepay_credit->identifier
1026                                                : $prepay_credit
1027                                            );
1028
1029   if ( $error ) {
1030     $dbh->rollback if $oldAutoCommit;
1031     return $error;
1032   }
1033
1034   if ( defined($amountref)  ) { $$amountref  = $amount;  }
1035   if ( defined($secondsref) ) { $$secondsref = $seconds; }
1036   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
1037   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
1038   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
1039
1040   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1041   '';
1042
1043 }
1044
1045 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
1046
1047 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
1048 specified either by I<identifier> or as an FS::prepay_credit object.
1049
1050 Available options are: I<amount_ref>, I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.  The scalars (provided by references) will be
1051 incremented by the values of the prepaid card.
1052
1053 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
1054 check or set this customer's I<agentnum>.
1055
1056 If there is an error, returns the error, otherwise returns false.
1057
1058 =cut
1059
1060
1061 sub get_prepay {
1062   my( $self, $prepay_credit, %opt ) = @_;
1063
1064   local $SIG{HUP} = 'IGNORE';
1065   local $SIG{INT} = 'IGNORE';
1066   local $SIG{QUIT} = 'IGNORE';
1067   local $SIG{TERM} = 'IGNORE';
1068   local $SIG{TSTP} = 'IGNORE';
1069   local $SIG{PIPE} = 'IGNORE';
1070
1071   my $oldAutoCommit = $FS::UID::AutoCommit;
1072   local $FS::UID::AutoCommit = 0;
1073   my $dbh = dbh;
1074
1075   unless ( ref($prepay_credit) ) {
1076
1077     my $identifier = $prepay_credit;
1078
1079     $prepay_credit = qsearchs(
1080       'prepay_credit',
1081       { 'identifier' => $prepay_credit },
1082       '',
1083       'FOR UPDATE'
1084     );
1085
1086     unless ( $prepay_credit ) {
1087       $dbh->rollback if $oldAutoCommit;
1088       return "Invalid prepaid card: ". $identifier;
1089     }
1090
1091   }
1092
1093   if ( $prepay_credit->agentnum ) {
1094     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1095       $dbh->rollback if $oldAutoCommit;
1096       return "prepaid card not valid for agent ". $self->agentnum;
1097     }
1098     $self->agentnum($prepay_credit->agentnum);
1099   }
1100
1101   my $error = $prepay_credit->delete;
1102   if ( $error ) {
1103     $dbh->rollback if $oldAutoCommit;
1104     return "removing prepay_credit (transaction rolled back): $error";
1105   }
1106
1107   ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1108     for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1109
1110   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1111   '';
1112
1113 }
1114
1115 =item increment_upbytes SECONDS
1116
1117 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1118 the specified number of upbytes.  If there is an error, returns the error,
1119 otherwise returns false.
1120
1121 =cut
1122
1123 sub increment_upbytes {
1124   _increment_column( shift, 'upbytes', @_);
1125 }
1126
1127 =item increment_downbytes SECONDS
1128
1129 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1130 the specified number of downbytes.  If there is an error, returns the error,
1131 otherwise returns false.
1132
1133 =cut
1134
1135 sub increment_downbytes {
1136   _increment_column( shift, 'downbytes', @_);
1137 }
1138
1139 =item increment_totalbytes SECONDS
1140
1141 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1142 the specified number of totalbytes.  If there is an error, returns the error,
1143 otherwise returns false.
1144
1145 =cut
1146
1147 sub increment_totalbytes {
1148   _increment_column( shift, 'totalbytes', @_);
1149 }
1150
1151 =item increment_seconds SECONDS
1152
1153 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1154 the specified number of seconds.  If there is an error, returns the error,
1155 otherwise returns false.
1156
1157 =cut
1158
1159 sub increment_seconds {
1160   _increment_column( shift, 'seconds', @_);
1161 }
1162
1163 =item _increment_column AMOUNT
1164
1165 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1166 the specified number of seconds or bytes.  If there is an error, returns
1167 the error, otherwise returns false.
1168
1169 =cut
1170
1171 sub _increment_column {
1172   my( $self, $column, $amount ) = @_;
1173   warn "$me increment_column called: $column, $amount\n"
1174     if $DEBUG;
1175
1176   return '' unless $amount;
1177
1178   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1179                       $self->ncancelled_pkgs;
1180
1181   if ( ! @cust_pkg ) {
1182     return 'No packages with primary or single services found'.
1183            ' to apply pre-paid time';
1184   } elsif ( scalar(@cust_pkg) > 1 ) {
1185     #maybe have a way to specify the package/account?
1186     return 'Multiple packages found to apply pre-paid time';
1187   }
1188
1189   my $cust_pkg = $cust_pkg[0];
1190   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
1191     if $DEBUG > 1;
1192
1193   my @cust_svc =
1194     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1195
1196   if ( ! @cust_svc ) {
1197     return 'No account found to apply pre-paid time';
1198   } elsif ( scalar(@cust_svc) > 1 ) {
1199     return 'Multiple accounts found to apply pre-paid time';
1200   }
1201
1202   my $svc_acct = $cust_svc[0]->svc_x;
1203   warn "  found service svcnum ". $svc_acct->pkgnum.
1204        ' ('. $svc_acct->email. ")\n"
1205     if $DEBUG > 1;
1206
1207   $column = "increment_$column";
1208   $svc_acct->$column($amount);
1209
1210 }
1211
1212 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1213
1214 Inserts a prepayment in the specified amount for this customer.  An optional
1215 second argument can specify the prepayment identifier for tracking purposes.
1216 If there is an error, returns the error, otherwise returns false.
1217
1218 =cut
1219
1220 sub insert_cust_pay_prepay {
1221   shift->insert_cust_pay('PREP', @_);
1222 }
1223
1224 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1225
1226 Inserts a cash payment in the specified amount for this customer.  An optional
1227 second argument can specify the payment identifier for tracking purposes.
1228 If there is an error, returns the error, otherwise returns false.
1229
1230 =cut
1231
1232 sub insert_cust_pay_cash {
1233   shift->insert_cust_pay('CASH', @_);
1234 }
1235
1236 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1237
1238 Inserts a Western Union payment in the specified amount for this customer.  An
1239 optional second argument can specify the prepayment identifier for tracking
1240 purposes.  If there is an error, returns the error, otherwise returns false.
1241
1242 =cut
1243
1244 sub insert_cust_pay_west {
1245   shift->insert_cust_pay('WEST', @_);
1246 }
1247
1248 sub insert_cust_pay {
1249   my( $self, $payby, $amount ) = splice(@_, 0, 3);
1250   my $payinfo = scalar(@_) ? shift : '';
1251
1252   my $cust_pay = new FS::cust_pay {
1253     'custnum' => $self->custnum,
1254     'paid'    => sprintf('%.2f', $amount),
1255     #'_date'   => #date the prepaid card was purchased???
1256     'payby'   => $payby,
1257     'payinfo' => $payinfo,
1258   };
1259   $cust_pay->insert;
1260
1261 }
1262
1263 =item reexport
1264
1265 This method is deprecated.  See the I<depend_jobnum> option to the insert and
1266 order_pkgs methods for a better way to defer provisioning.
1267
1268 Re-schedules all exports by calling the B<reexport> method of all associated
1269 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
1270 otherwise returns false.
1271
1272 =cut
1273
1274 sub reexport {
1275   my $self = shift;
1276
1277   carp "WARNING: FS::cust_main::reexport is deprectated; ".
1278        "use the depend_jobnum option to insert or order_pkgs to delay export";
1279
1280   local $SIG{HUP} = 'IGNORE';
1281   local $SIG{INT} = 'IGNORE';
1282   local $SIG{QUIT} = 'IGNORE';
1283   local $SIG{TERM} = 'IGNORE';
1284   local $SIG{TSTP} = 'IGNORE';
1285   local $SIG{PIPE} = 'IGNORE';
1286
1287   my $oldAutoCommit = $FS::UID::AutoCommit;
1288   local $FS::UID::AutoCommit = 0;
1289   my $dbh = dbh;
1290
1291   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1292     my $error = $cust_pkg->reexport;
1293     if ( $error ) {
1294       $dbh->rollback if $oldAutoCommit;
1295       return $error;
1296     }
1297   }
1298
1299   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1300   '';
1301
1302 }
1303
1304 =item delete [ OPTION => VALUE ... ]
1305
1306 This deletes the customer.  If there is an error, returns the error, otherwise
1307 returns false.
1308
1309 This will completely remove all traces of the customer record.  This is not
1310 what you want when a customer cancels service; for that, cancel all of the
1311 customer's packages (see L</cancel>).
1312
1313 If the customer has any uncancelled packages, you need to pass a new (valid)
1314 customer number for those packages to be transferred to, as the "new_customer"
1315 option.  Cancelled packages will be deleted.  Did I mention that this is NOT
1316 what you want when a customer cancels service and that you really should be
1317 looking at L<FS::cust_pkg/cancel>?
1318
1319 You can't delete a customer with invoices (see L<FS::cust_bill>),
1320 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1321 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1322 set the "delete_financials" option to a true value.
1323
1324 =cut
1325
1326 sub delete {
1327   my( $self, %opt ) = @_;
1328
1329   local $SIG{HUP} = 'IGNORE';
1330   local $SIG{INT} = 'IGNORE';
1331   local $SIG{QUIT} = 'IGNORE';
1332   local $SIG{TERM} = 'IGNORE';
1333   local $SIG{TSTP} = 'IGNORE';
1334   local $SIG{PIPE} = 'IGNORE';
1335
1336   my $oldAutoCommit = $FS::UID::AutoCommit;
1337   local $FS::UID::AutoCommit = 0;
1338   my $dbh = dbh;
1339
1340   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1341      $dbh->rollback if $oldAutoCommit;
1342      return "Can't delete a master agent customer";
1343   }
1344
1345   #use FS::access_user
1346   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1347      $dbh->rollback if $oldAutoCommit;
1348      return "Can't delete a master employee customer";
1349   }
1350
1351   tie my %financial_tables, 'Tie::IxHash',
1352     'cust_bill'      => 'invoices',
1353     'cust_statement' => 'statements',
1354     'cust_credit'    => 'credits',
1355     'cust_pay'       => 'payments',
1356     'cust_refund'    => 'refunds',
1357   ;
1358
1359   foreach my $table ( keys %financial_tables ) {
1360
1361     my @records = $self->$table();
1362
1363     if ( @records && ! $opt{'delete_financials'} ) {
1364       $dbh->rollback if $oldAutoCommit;
1365       return "Can't delete a customer with ". $financial_tables{$table};
1366     }
1367
1368     foreach my $record ( @records ) {
1369       my $error = $record->delete;
1370       if ( $error ) {
1371         $dbh->rollback if $oldAutoCommit;
1372         return "Error deleting ". $financial_tables{$table}. ": $error\n";
1373       }
1374     }
1375
1376   }
1377
1378   my @cust_pkg = $self->ncancelled_pkgs;
1379   if ( @cust_pkg ) {
1380     my $new_custnum = $opt{'new_custnum'};
1381     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1382       $dbh->rollback if $oldAutoCommit;
1383       return "Invalid new customer number: $new_custnum";
1384     }
1385     foreach my $cust_pkg ( @cust_pkg ) {
1386       my %hash = $cust_pkg->hash;
1387       $hash{'custnum'} = $new_custnum;
1388       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1389       my $error = $new_cust_pkg->replace($cust_pkg,
1390                                          options => { $cust_pkg->options },
1391                                         );
1392       if ( $error ) {
1393         $dbh->rollback if $oldAutoCommit;
1394         return $error;
1395       }
1396     }
1397   }
1398   my @cancelled_cust_pkg = $self->all_pkgs;
1399   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1400     my $error = $cust_pkg->delete;
1401     if ( $error ) {
1402       $dbh->rollback if $oldAutoCommit;
1403       return $error;
1404     }
1405   }
1406
1407   #cust_tax_adjustment in financials?
1408   #cust_pay_pending?  ouch
1409   #cust_recon?
1410   foreach my $table (qw(
1411     cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1412     cust_location cust_main_note cust_tax_adjustment
1413     cust_pay_void cust_pay_batch queue cust_tax_exempt
1414   )) {
1415     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1416       my $error = $record->delete;
1417       if ( $error ) {
1418         $dbh->rollback if $oldAutoCommit;
1419         return $error;
1420       }
1421     }
1422   }
1423
1424   my $sth = $dbh->prepare(
1425     'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1426   ) or do {
1427     my $errstr = $dbh->errstr;
1428     $dbh->rollback if $oldAutoCommit;
1429     return $errstr;
1430   };
1431   $sth->execute($self->custnum) or do {
1432     my $errstr = $sth->errstr;
1433     $dbh->rollback if $oldAutoCommit;
1434     return $errstr;
1435   };
1436
1437   #tickets
1438
1439   my $ticket_dbh = '';
1440   if ($conf->config('ticket_system') eq 'RT_Internal') {
1441     $ticket_dbh = $dbh;
1442   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1443     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1444     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1445       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1446   }
1447
1448   if ( $ticket_dbh ) {
1449
1450     my $ticket_sth = $ticket_dbh->prepare(
1451       'DELETE FROM Links WHERE Target = ?'
1452     ) or do {
1453       my $errstr = $ticket_dbh->errstr;
1454       $dbh->rollback if $oldAutoCommit;
1455       return $errstr;
1456     };
1457     $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1458       or do {
1459         my $errstr = $ticket_sth->errstr;
1460         $dbh->rollback if $oldAutoCommit;
1461         return $errstr;
1462       };
1463
1464     #check and see if the customer is the only link on the ticket, and
1465     #if so, set the ticket to deleted status in RT?
1466     #maybe someday, for now this will at least fix tickets not displaying
1467
1468   }
1469
1470   #delete the customer record
1471
1472   my $error = $self->SUPER::delete;
1473   if ( $error ) {
1474     $dbh->rollback if $oldAutoCommit;
1475     return $error;
1476   }
1477
1478   # cust_main exports!
1479
1480   #my $export_args = $options{'export_args'} || [];
1481
1482   my @part_export =
1483     map qsearch( 'part_export', {exportnum=>$_} ),
1484       $conf->config('cust_main-exports'); #, $agentnum
1485
1486   foreach my $part_export ( @part_export ) {
1487     my $error = $part_export->export_delete( $self ); #, @$export_args);
1488     if ( $error ) {
1489       $dbh->rollback if $oldAutoCommit;
1490       return "exporting to ". $part_export->exporttype.
1491              " (transaction rolled back): $error";
1492     }
1493   }
1494
1495   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1496   '';
1497
1498 }
1499
1500 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1501
1502
1503 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1504 returns the error, otherwise returns false.
1505
1506 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1507 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1508 expected and rollback the entire transaction; it is not necessary to call
1509 check_invoicing_list first.  Here's an example:
1510
1511   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1512
1513 Currently available options are: I<tax_exemption>.
1514
1515 The I<tax_exemption> option can be set to an arrayref of tax names.
1516 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1517
1518 =cut
1519
1520 sub replace {
1521   my $self = shift;
1522
1523   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1524               ? shift
1525               : $self->replace_old;
1526
1527   my @param = @_;
1528
1529   warn "$me replace called\n"
1530     if $DEBUG;
1531
1532   my $curuser = $FS::CurrentUser::CurrentUser;
1533   if (    $self->payby eq 'COMP'
1534        && $self->payby ne $old->payby
1535        && ! $curuser->access_right('Complimentary customer')
1536      )
1537   {
1538     return "You are not permitted to create complimentary accounts.";
1539   }
1540
1541   local($ignore_expired_card) = 1
1542     if $old->payby  =~ /^(CARD|DCRD)$/
1543     && $self->payby =~ /^(CARD|DCRD)$/
1544     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1545
1546   local $SIG{HUP} = 'IGNORE';
1547   local $SIG{INT} = 'IGNORE';
1548   local $SIG{QUIT} = 'IGNORE';
1549   local $SIG{TERM} = 'IGNORE';
1550   local $SIG{TSTP} = 'IGNORE';
1551   local $SIG{PIPE} = 'IGNORE';
1552
1553   my $oldAutoCommit = $FS::UID::AutoCommit;
1554   local $FS::UID::AutoCommit = 0;
1555   my $dbh = dbh;
1556
1557   my $error = $self->SUPER::replace($old);
1558
1559   if ( $error ) {
1560     $dbh->rollback if $oldAutoCommit;
1561     return $error;
1562   }
1563
1564   if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1565     my $invoicing_list = shift @param;
1566     $error = $self->check_invoicing_list( $invoicing_list );
1567     if ( $error ) {
1568       $dbh->rollback if $oldAutoCommit;
1569       return $error;
1570     }
1571     $self->invoicing_list( $invoicing_list );
1572   }
1573
1574   if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1575
1576     #this could be more efficient than deleting and re-inserting, if it matters
1577     foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1578       my $error = $cust_tag->delete;
1579       if ( $error ) {
1580         $dbh->rollback if $oldAutoCommit;
1581         return $error;
1582       }
1583     }
1584     foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1585       my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
1586                                         'custnum' => $self->custnum };
1587       my $error = $cust_tag->insert;
1588       if ( $error ) {
1589         $dbh->rollback if $oldAutoCommit;
1590         return $error;
1591       }
1592     }
1593
1594   }
1595
1596   my %options = @param;
1597
1598   my $tax_exemption = delete $options{'tax_exemption'};
1599   if ( $tax_exemption ) {
1600
1601     my %cust_main_exemption =
1602       map { $_->taxname => $_ }
1603           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1604
1605     foreach my $taxname ( @$tax_exemption ) {
1606
1607       next if delete $cust_main_exemption{$taxname};
1608
1609       my $cust_main_exemption = new FS::cust_main_exemption {
1610         'custnum' => $self->custnum,
1611         'taxname' => $taxname,
1612       };
1613       my $error = $cust_main_exemption->insert;
1614       if ( $error ) {
1615         $dbh->rollback if $oldAutoCommit;
1616         return "inserting cust_main_exemption (transaction rolled back): $error";
1617       }
1618     }
1619
1620     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1621       my $error = $cust_main_exemption->delete;
1622       if ( $error ) {
1623         $dbh->rollback if $oldAutoCommit;
1624         return "deleting cust_main_exemption (transaction rolled back): $error";
1625       }
1626     }
1627
1628   }
1629
1630   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1631        && ( ( $self->get('payinfo') ne $old->get('payinfo')
1632               && $self->get('payinfo') !~ /^99\d{14}$/
1633             )
1634             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1635           )
1636      )
1637   {
1638
1639     # card/check/lec info has changed, want to retry realtime_ invoice events
1640     my $error = $self->retry_realtime;
1641     if ( $error ) {
1642       $dbh->rollback if $oldAutoCommit;
1643       return $error;
1644     }
1645   }
1646
1647   unless ( $import || $skip_fuzzyfiles ) {
1648     $error = $self->queue_fuzzyfiles_update;
1649     if ( $error ) {
1650       $dbh->rollback if $oldAutoCommit;
1651       return "updating fuzzy search cache: $error";
1652     }
1653   }
1654
1655   # cust_main exports!
1656
1657   my $export_args = $options{'export_args'} || [];
1658
1659   my @part_export =
1660     map qsearch( 'part_export', {exportnum=>$_} ),
1661       $conf->config('cust_main-exports'); #, $agentnum
1662
1663   foreach my $part_export ( @part_export ) {
1664     my $error = $part_export->export_replace( $self, $old, @$export_args);
1665     if ( $error ) {
1666       $dbh->rollback if $oldAutoCommit;
1667       return "exporting to ". $part_export->exporttype.
1668              " (transaction rolled back): $error";
1669     }
1670   }
1671
1672   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1673   '';
1674
1675 }
1676
1677 =item queue_fuzzyfiles_update
1678
1679 Used by insert & replace to update the fuzzy search cache
1680
1681 =cut
1682
1683 sub queue_fuzzyfiles_update {
1684   my $self = shift;
1685
1686   local $SIG{HUP} = 'IGNORE';
1687   local $SIG{INT} = 'IGNORE';
1688   local $SIG{QUIT} = 'IGNORE';
1689   local $SIG{TERM} = 'IGNORE';
1690   local $SIG{TSTP} = 'IGNORE';
1691   local $SIG{PIPE} = 'IGNORE';
1692
1693   my $oldAutoCommit = $FS::UID::AutoCommit;
1694   local $FS::UID::AutoCommit = 0;
1695   my $dbh = dbh;
1696
1697   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1698   my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1699   if ( $error ) {
1700     $dbh->rollback if $oldAutoCommit;
1701     return "queueing job (transaction rolled back): $error";
1702   }
1703
1704   if ( $self->ship_last ) {
1705     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1706     $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1707     if ( $error ) {
1708       $dbh->rollback if $oldAutoCommit;
1709       return "queueing job (transaction rolled back): $error";
1710     }
1711   }
1712
1713   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1714   '';
1715
1716 }
1717
1718 =item check
1719
1720 Checks all fields to make sure this is a valid customer record.  If there is
1721 an error, returns the error, otherwise returns false.  Called by the insert
1722 and replace methods.
1723
1724 =cut
1725
1726 sub check {
1727   my $self = shift;
1728
1729   warn "$me check BEFORE: \n". $self->_dump
1730     if $DEBUG > 2;
1731
1732   my $error =
1733     $self->ut_numbern('custnum')
1734     || $self->ut_number('agentnum')
1735     || $self->ut_textn('agent_custid')
1736     || $self->ut_number('refnum')
1737     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1738     || $self->ut_textn('custbatch')
1739     || $self->ut_name('last')
1740     || $self->ut_name('first')
1741     || $self->ut_snumbern('birthdate')
1742     || $self->ut_snumbern('signupdate')
1743     || $self->ut_textn('company')
1744     || $self->ut_text('address1')
1745     || $self->ut_textn('address2')
1746     || $self->ut_text('city')
1747     || $self->ut_textn('county')
1748     || $self->ut_textn('state')
1749     || $self->ut_country('country')
1750     || $self->ut_anything('comments')
1751     || $self->ut_numbern('referral_custnum')
1752     || $self->ut_textn('stateid')
1753     || $self->ut_textn('stateid_state')
1754     || $self->ut_textn('invoice_terms')
1755     || $self->ut_alphan('geocode')
1756     || $self->ut_floatn('cdr_termination_percentage')
1757   ;
1758
1759   #barf.  need message catalogs.  i18n.  etc.
1760   $error .= "Please select an advertising source."
1761     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1762   return $error if $error;
1763
1764   return "Unknown agent"
1765     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1766
1767   return "Unknown refnum"
1768     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1769
1770   return "Unknown referring custnum: ". $self->referral_custnum
1771     unless ! $self->referral_custnum
1772            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1773
1774   if ( $self->censustract ne '' ) {
1775     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1776       or return "Illegal census tract: ". $self->censustract;
1777
1778     $self->censustract("$1.$2");
1779   }
1780
1781   if ( $self->ss eq '' ) {
1782     $self->ss('');
1783   } else {
1784     my $ss = $self->ss;
1785     $ss =~ s/\D//g;
1786     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1787       or return "Illegal social security number: ". $self->ss;
1788     $self->ss("$1-$2-$3");
1789   }
1790
1791
1792 # bad idea to disable, causes billing to fail because of no tax rates later
1793 #  unless ( $import ) {
1794     unless ( qsearch('cust_main_county', {
1795       'country' => $self->country,
1796       'state'   => '',
1797      } ) ) {
1798       return "Unknown state/county/country: ".
1799         $self->state. "/". $self->county. "/". $self->country
1800         unless qsearch('cust_main_county',{
1801           'state'   => $self->state,
1802           'county'  => $self->county,
1803           'country' => $self->country,
1804         } );
1805     }
1806 #  }
1807
1808   $error =
1809     $self->ut_phonen('daytime', $self->country)
1810     || $self->ut_phonen('night', $self->country)
1811     || $self->ut_phonen('fax', $self->country)
1812     || $self->ut_zip('zip', $self->country)
1813   ;
1814   return $error if $error;
1815
1816   if ( $conf->exists('cust_main-require_phone')
1817        && ! length($self->daytime) && ! length($self->night)
1818      ) {
1819
1820     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1821                           ? 'Day Phone'
1822                           : FS::Msgcat::_gettext('daytime');
1823     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1824                         ? 'Night Phone'
1825                         : FS::Msgcat::_gettext('night');
1826
1827     return "$daytime_label or $night_label is required"
1828
1829   }
1830
1831   if ( $self->has_ship_address
1832        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1833                         $self->addr_fields )
1834      )
1835   {
1836     my $error =
1837       $self->ut_name('ship_last')
1838       || $self->ut_name('ship_first')
1839       || $self->ut_textn('ship_company')
1840       || $self->ut_text('ship_address1')
1841       || $self->ut_textn('ship_address2')
1842       || $self->ut_text('ship_city')
1843       || $self->ut_textn('ship_county')
1844       || $self->ut_textn('ship_state')
1845       || $self->ut_country('ship_country')
1846     ;
1847     return $error if $error;
1848
1849     #false laziness with above
1850     unless ( qsearchs('cust_main_county', {
1851       'country' => $self->ship_country,
1852       'state'   => '',
1853      } ) ) {
1854       return "Unknown ship_state/ship_county/ship_country: ".
1855         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1856         unless qsearch('cust_main_county',{
1857           'state'   => $self->ship_state,
1858           'county'  => $self->ship_county,
1859           'country' => $self->ship_country,
1860         } );
1861     }
1862     #eofalse
1863
1864     $error =
1865       $self->ut_phonen('ship_daytime', $self->ship_country)
1866       || $self->ut_phonen('ship_night', $self->ship_country)
1867       || $self->ut_phonen('ship_fax', $self->ship_country)
1868       || $self->ut_zip('ship_zip', $self->ship_country)
1869     ;
1870     return $error if $error;
1871
1872     return "Unit # is required."
1873       if $self->ship_address2 =~ /^\s*$/
1874       && $conf->exists('cust_main-require_address2');
1875
1876   } else { # ship_ info eq billing info, so don't store dup info in database
1877
1878     $self->setfield("ship_$_", '')
1879       foreach $self->addr_fields;
1880
1881     return "Unit # is required."
1882       if $self->address2 =~ /^\s*$/
1883       && $conf->exists('cust_main-require_address2');
1884
1885   }
1886
1887   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1888   #  or return "Illegal payby: ". $self->payby;
1889   #$self->payby($1);
1890   FS::payby->can_payby($self->table, $self->payby)
1891     or return "Illegal payby: ". $self->payby;
1892
1893   $error =    $self->ut_numbern('paystart_month')
1894            || $self->ut_numbern('paystart_year')
1895            || $self->ut_numbern('payissue')
1896            || $self->ut_textn('paytype')
1897   ;
1898   return $error if $error;
1899
1900   if ( $self->payip eq '' ) {
1901     $self->payip('');
1902   } else {
1903     $error = $self->ut_ip('payip');
1904     return $error if $error;
1905   }
1906
1907   # If it is encrypted and the private key is not availaible then we can't
1908   # check the credit card.
1909   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1910
1911   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1912
1913     my $payinfo = $self->payinfo;
1914     $payinfo =~ s/\D//g;
1915     $payinfo =~ /^(\d{13,16})$/
1916       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1917     $payinfo = $1;
1918     $self->payinfo($payinfo);
1919     validate($payinfo)
1920       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1921
1922     return gettext('unknown_card_type')
1923       if $self->payinfo !~ /^99\d{14}$/ #token
1924       && cardtype($self->payinfo) eq "Unknown";
1925
1926     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1927     if ( $ban ) {
1928       return 'Banned credit card: banned on '.
1929              time2str('%a %h %o at %r', $ban->_date).
1930              ' by '. $ban->otaker.
1931              ' (ban# '. $ban->bannum. ')';
1932     }
1933
1934     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1935       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1936         $self->paycvv =~ /^(\d{4})$/
1937           or return "CVV2 (CID) for American Express cards is four digits.";
1938         $self->paycvv($1);
1939       } else {
1940         $self->paycvv =~ /^(\d{3})$/
1941           or return "CVV2 (CVC2/CID) is three digits.";
1942         $self->paycvv($1);
1943       }
1944     } else {
1945       $self->paycvv('');
1946     }
1947
1948     my $cardtype = cardtype($payinfo);
1949     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1950
1951       return "Start date or issue number is required for $cardtype cards"
1952         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1953
1954       return "Start month must be between 1 and 12"
1955         if $self->paystart_month
1956            and $self->paystart_month < 1 || $self->paystart_month > 12;
1957
1958       return "Start year must be 1990 or later"
1959         if $self->paystart_year
1960            and $self->paystart_year < 1990;
1961
1962       return "Issue number must be beween 1 and 99"
1963         if $self->payissue
1964           and $self->payissue < 1 || $self->payissue > 99;
1965
1966     } else {
1967       $self->paystart_month('');
1968       $self->paystart_year('');
1969       $self->payissue('');
1970     }
1971
1972   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1973
1974     my $payinfo = $self->payinfo;
1975     $payinfo =~ s/[^\d\@]//g;
1976     if ( $conf->exists('echeck-nonus') ) {
1977       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1978       $payinfo = "$1\@$2";
1979     } else {
1980       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1981       $payinfo = "$1\@$2";
1982     }
1983     $self->payinfo($payinfo);
1984     $self->paycvv('');
1985
1986     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1987     if ( $ban ) {
1988       return 'Banned ACH account: banned on '.
1989              time2str('%a %h %o at %r', $ban->_date).
1990              ' by '. $ban->otaker.
1991              ' (ban# '. $ban->bannum. ')';
1992     }
1993
1994   } elsif ( $self->payby eq 'LECB' ) {
1995
1996     my $payinfo = $self->payinfo;
1997     $payinfo =~ s/\D//g;
1998     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1999     $payinfo = $1;
2000     $self->payinfo($payinfo);
2001     $self->paycvv('');
2002
2003   } elsif ( $self->payby eq 'BILL' ) {
2004
2005     $error = $self->ut_textn('payinfo');
2006     return "Illegal P.O. number: ". $self->payinfo if $error;
2007     $self->paycvv('');
2008
2009   } elsif ( $self->payby eq 'COMP' ) {
2010
2011     my $curuser = $FS::CurrentUser::CurrentUser;
2012     if (    ! $self->custnum
2013          && ! $curuser->access_right('Complimentary customer')
2014        )
2015     {
2016       return "You are not permitted to create complimentary accounts."
2017     }
2018
2019     $error = $self->ut_textn('payinfo');
2020     return "Illegal comp account issuer: ". $self->payinfo if $error;
2021     $self->paycvv('');
2022
2023   } elsif ( $self->payby eq 'PREPAY' ) {
2024
2025     my $payinfo = $self->payinfo;
2026     $payinfo =~ s/\W//g; #anything else would just confuse things
2027     $self->payinfo($payinfo);
2028     $error = $self->ut_alpha('payinfo');
2029     return "Illegal prepayment identifier: ". $self->payinfo if $error;
2030     return "Unknown prepayment identifier"
2031       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2032     $self->paycvv('');
2033
2034   }
2035
2036   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2037     return "Expiration date required"
2038       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
2039     $self->paydate('');
2040   } else {
2041     my( $m, $y );
2042     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2043       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2044     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2045       ( $m, $y ) = ( $2, "19$1" );
2046     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2047       ( $m, $y ) = ( $3, "20$2" );
2048     } else {
2049       return "Illegal expiration date: ". $self->paydate;
2050     }
2051     $self->paydate("$y-$m-01");
2052     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2053     return gettext('expired_card')
2054       if !$import
2055       && !$ignore_expired_card
2056       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2057   }
2058
2059   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2060        ( ! $conf->exists('require_cardname')
2061          || $self->payby !~ /^(CARD|DCRD)$/  )
2062   ) {
2063     $self->payname( $self->first. " ". $self->getfield('last') );
2064   } else {
2065     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2066       or return gettext('illegal_name'). " payname: ". $self->payname;
2067     $self->payname($1);
2068   }
2069
2070   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2071     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2072     $self->$flag($1);
2073   }
2074
2075   $self->otaker(getotaker) unless $self->otaker;
2076
2077   warn "$me check AFTER: \n". $self->_dump
2078     if $DEBUG > 2;
2079
2080   $self->SUPER::check;
2081 }
2082
2083 =item addr_fields
2084
2085 Returns a list of fields which have ship_ duplicates.
2086
2087 =cut
2088
2089 sub addr_fields {
2090   qw( last first company
2091       address1 address2 city county state zip country
2092       daytime night fax
2093     );
2094 }
2095
2096 =item has_ship_address
2097
2098 Returns true if this customer record has a separate shipping address.
2099
2100 =cut
2101
2102 sub has_ship_address {
2103   my $self = shift;
2104   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2105 }
2106
2107 =item location_hash
2108
2109 Returns a list of key/value pairs, with the following keys: address1, adddress2,
2110 city, county, state, zip, country.  The shipping address is used if present.
2111
2112 =cut
2113
2114 #geocode?  dependent on tax-ship_address config, not available in cust_location
2115 #mostly.  not yet then.
2116
2117 sub location_hash {
2118   my $self = shift;
2119   my $prefix = $self->has_ship_address ? 'ship_' : '';
2120
2121   map { $_ => $self->get($prefix.$_) }
2122       qw( address1 address2 city county state zip country geocode );
2123       #fields that cust_location has
2124 }
2125
2126 =item all_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2127
2128 Returns all packages (see L<FS::cust_pkg>) for this customer.
2129
2130 =cut
2131
2132 sub all_pkgs {
2133   my $self = shift;
2134   my $extra_qsearch = ref($_[0]) ? shift : {};
2135
2136   return $self->num_pkgs unless wantarray || keys(%$extra_qsearch);
2137
2138   my @cust_pkg = ();
2139   if ( $self->{'_pkgnum'} ) {
2140     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
2141   } else {
2142     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2143   }
2144
2145   sort sort_packages @cust_pkg;
2146 }
2147
2148 =item cust_pkg
2149
2150 Synonym for B<all_pkgs>.
2151
2152 =cut
2153
2154 sub cust_pkg {
2155   shift->all_pkgs(@_);
2156 }
2157
2158 =item cust_location
2159
2160 Returns all locations (see L<FS::cust_location>) for this customer.
2161
2162 =cut
2163
2164 sub cust_location {
2165   my $self = shift;
2166   qsearch('cust_location', { 'custnum' => $self->custnum } );
2167 }
2168
2169 =item location_label [ OPTION => VALUE ... ]
2170
2171 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
2172
2173 Options are
2174
2175 =over 4
2176
2177 =item join_string
2178
2179 used to separate the address elements (defaults to ', ')
2180
2181 =item escape_function
2182
2183 a callback used for escaping the text of the address elements
2184
2185 =back
2186
2187 =cut
2188
2189 # false laziness with FS::cust_location::line
2190
2191 sub location_label {
2192   my $self = shift;
2193   my %opt = @_;
2194
2195   my $separator = $opt{join_string} || ', ';
2196   my $escape = $opt{escape_function} || sub{ shift };
2197   my $line = '';
2198   my $cydefault = FS::conf->new->config('countrydefault') || 'US';
2199   my $prefix = length($self->ship_last) ? 'ship_' : '';
2200
2201   my $notfirst = 0;
2202   foreach (qw ( address1 address2 ) ) {
2203     my $method = "$prefix$_";
2204     $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
2205       if $self->$method;
2206     $notfirst++;
2207   }
2208   $notfirst = 0;
2209   foreach (qw ( city county state zip ) ) {
2210     my $method = "$prefix$_";
2211     if ( $self->$method ) {
2212       $line .= ' (' if $method eq 'county';
2213       $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
2214       $line .= ' )' if $method eq 'county';
2215       $notfirst++;
2216     }
2217   }
2218   $line .= $separator. &$escape(code2country($self->country))
2219     if $self->country ne $cydefault;
2220
2221   $line;
2222 }
2223
2224 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2225
2226 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
2227
2228 =cut
2229
2230 sub ncancelled_pkgs {
2231   my $self = shift;
2232   my $extra_qsearch = ref($_[0]) ? shift : {};
2233
2234   return $self->num_ncancelled_pkgs unless wantarray;
2235
2236   my @cust_pkg = ();
2237   if ( $self->{'_pkgnum'} ) {
2238
2239     warn "$me ncancelled_pkgs: returning cached objects"
2240       if $DEBUG > 1;
2241
2242     @cust_pkg = grep { ! $_->getfield('cancel') }
2243                 values %{ $self->{'_pkgnum'}->cache };
2244
2245   } else {
2246
2247     warn "$me ncancelled_pkgs: searching for packages with custnum ".
2248          $self->custnum. "\n"
2249       if $DEBUG > 1;
2250
2251     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
2252
2253     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2254
2255   }
2256
2257   sort sort_packages @cust_pkg;
2258
2259 }
2260
2261 sub _cust_pkg {
2262   my $self = shift;
2263   my $extra_qsearch = ref($_[0]) ? shift : {};
2264
2265   $extra_qsearch->{'select'} ||= '*';
2266   $extra_qsearch->{'select'} .=
2267    ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2268      AS _num_cust_svc';
2269
2270   map {
2271         $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2272         $_;
2273       }
2274   qsearch({
2275     %$extra_qsearch,
2276     'table'   => 'cust_pkg',
2277     'hashref' => { 'custnum' => $self->custnum },
2278   });
2279
2280 }
2281
2282 # This should be generalized to use config options to determine order.
2283 sub sort_packages {
2284
2285   my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
2286   return $locationsort if $locationsort;
2287
2288   if ( $a->get('cancel') xor $b->get('cancel') ) {
2289     return -1 if $b->get('cancel');
2290     return  1 if $a->get('cancel');
2291     #shouldn't get here...
2292     return 0;
2293   } else {
2294     my $a_num_cust_svc = $a->num_cust_svc;
2295     my $b_num_cust_svc = $b->num_cust_svc;
2296     return 0  if !$a_num_cust_svc && !$b_num_cust_svc;
2297     return -1 if  $a_num_cust_svc && !$b_num_cust_svc;
2298     return 1  if !$a_num_cust_svc &&  $b_num_cust_svc;
2299     my @a_cust_svc = $a->cust_svc;
2300     my @b_cust_svc = $b->cust_svc;
2301     return 0  if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2302     return -1 if  scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2303     return 1  if !scalar(@a_cust_svc) &&  scalar(@b_cust_svc);
2304     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2305   }
2306
2307 }
2308
2309 =item suspended_pkgs
2310
2311 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2312
2313 =cut
2314
2315 sub suspended_pkgs {
2316   my $self = shift;
2317   grep { $_->susp } $self->ncancelled_pkgs;
2318 }
2319
2320 =item unflagged_suspended_pkgs
2321
2322 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2323 customer (thouse packages without the `manual_flag' set).
2324
2325 =cut
2326
2327 sub unflagged_suspended_pkgs {
2328   my $self = shift;
2329   return $self->suspended_pkgs
2330     unless dbdef->table('cust_pkg')->column('manual_flag');
2331   grep { ! $_->manual_flag } $self->suspended_pkgs;
2332 }
2333
2334 =item unsuspended_pkgs
2335
2336 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2337 this customer.
2338
2339 =cut
2340
2341 sub unsuspended_pkgs {
2342   my $self = shift;
2343   grep { ! $_->susp } $self->ncancelled_pkgs;
2344 }
2345
2346 =item next_bill_date
2347
2348 Returns the next date this customer will be billed, as a UNIX timestamp, or
2349 undef if no active package has a next bill date.
2350
2351 =cut
2352
2353 sub next_bill_date {
2354   my $self = shift;
2355   min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2356 }
2357
2358 =item num_cancelled_pkgs
2359
2360 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2361 customer.
2362
2363 =cut
2364
2365 sub num_cancelled_pkgs {
2366   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2367 }
2368
2369 sub num_ncancelled_pkgs {
2370   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2371 }
2372
2373 sub num_pkgs {
2374   my( $self ) = shift;
2375   my $sql = scalar(@_) ? shift : '';
2376   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2377   my $sth = dbh->prepare(
2378     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2379   ) or die dbh->errstr;
2380   $sth->execute($self->custnum) or die $sth->errstr;
2381   $sth->fetchrow_arrayref->[0];
2382 }
2383
2384 =item unsuspend
2385
2386 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2387 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2388 on success or a list of errors.
2389
2390 =cut
2391
2392 sub unsuspend {
2393   my $self = shift;
2394   grep { $_->unsuspend } $self->suspended_pkgs;
2395 }
2396
2397 =item suspend
2398
2399 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2400
2401 Returns a list: an empty list on success or a list of errors.
2402
2403 =cut
2404
2405 sub suspend {
2406   my $self = shift;
2407   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2408 }
2409
2410 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2411
2412 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2413 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2414 of a list of pkgparts; the hashref has the following keys:
2415
2416 =over 4
2417
2418 =item pkgparts - listref of pkgparts
2419
2420 =item (other options are passed to the suspend method)
2421
2422 =back
2423
2424
2425 Returns a list: an empty list on success or a list of errors.
2426
2427 =cut
2428
2429 sub suspend_if_pkgpart {
2430   my $self = shift;
2431   my (@pkgparts, %opt);
2432   if (ref($_[0]) eq 'HASH'){
2433     @pkgparts = @{$_[0]{pkgparts}};
2434     %opt      = %{$_[0]};
2435   }else{
2436     @pkgparts = @_;
2437   }
2438   grep { $_->suspend(%opt) }
2439     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2440       $self->unsuspended_pkgs;
2441 }
2442
2443 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2444
2445 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2446 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2447 instead of a list of pkgparts; the hashref has the following keys:
2448
2449 =over 4
2450
2451 =item pkgparts - listref of pkgparts
2452
2453 =item (other options are passed to the suspend method)
2454
2455 =back
2456
2457 Returns a list: an empty list on success or a list of errors.
2458
2459 =cut
2460
2461 sub suspend_unless_pkgpart {
2462   my $self = shift;
2463   my (@pkgparts, %opt);
2464   if (ref($_[0]) eq 'HASH'){
2465     @pkgparts = @{$_[0]{pkgparts}};
2466     %opt      = %{$_[0]};
2467   }else{
2468     @pkgparts = @_;
2469   }
2470   grep { $_->suspend(%opt) }
2471     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2472       $self->unsuspended_pkgs;
2473 }
2474
2475 =item cancel [ OPTION => VALUE ... ]
2476
2477 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2478
2479 Available options are:
2480
2481 =over 4
2482
2483 =item quiet - can be set true to supress email cancellation notices.
2484
2485 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason.  The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
2486
2487 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2488
2489 =item nobill - can be set true to skip billing if it might otherwise be done.
2490
2491 =back
2492
2493 Always returns a list: an empty list on success or a list of errors.
2494
2495 =cut
2496
2497 # nb that dates are not specified as valid options to this method
2498
2499 sub cancel {
2500   my( $self, %opt ) = @_;
2501
2502   warn "$me cancel called on customer ". $self->custnum. " with options ".
2503        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2504     if $DEBUG;
2505
2506   return ( 'access denied' )
2507     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2508
2509   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2510
2511     #should try decryption (we might have the private key)
2512     # and if not maybe queue a job for the server that does?
2513     return ( "Can't (yet) ban encrypted credit cards" )
2514       if $self->is_encrypted($self->payinfo);
2515
2516     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2517     my $error = $ban->insert;
2518     return ( $error ) if $error;
2519
2520   }
2521
2522   my @pkgs = $self->ncancelled_pkgs;
2523
2524   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2525     $opt{nobill} = 1;
2526     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2527     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2528       if $error;
2529   }
2530
2531   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2532        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2533     if $DEBUG;
2534
2535   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2536 }
2537
2538 sub _banned_pay_hashref {
2539   my $self = shift;
2540
2541   my %payby2ban = (
2542     'CARD' => 'CARD',
2543     'DCRD' => 'CARD',
2544     'CHEK' => 'CHEK',
2545     'DCHK' => 'CHEK'
2546   );
2547
2548   {
2549     'payby'   => $payby2ban{$self->payby},
2550     'payinfo' => md5_base64($self->payinfo),
2551     #don't ever *search* on reason! #'reason'  =>
2552   };
2553 }
2554
2555 =item notes
2556
2557 Returns all notes (see L<FS::cust_main_note>) for this customer.
2558
2559 =cut
2560
2561 sub notes {
2562   my $self = shift;
2563   #order by?
2564   qsearch( 'cust_main_note',
2565            { 'custnum' => $self->custnum },
2566            '',
2567            'ORDER BY _DATE DESC'
2568          );
2569 }
2570
2571 =item agent
2572
2573 Returns the agent (see L<FS::agent>) for this customer.
2574
2575 =cut
2576
2577 sub agent {
2578   my $self = shift;
2579   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2580 }
2581
2582 =item agent_name
2583
2584 Returns the agent name (see L<FS::agent>) for this customer.
2585
2586 =cut
2587
2588 sub agent_name {
2589   my $self = shift;
2590   $self->agent->agent;
2591 }
2592
2593 =item cust_tag
2594
2595 Returns any tags associated with this customer, as FS::cust_tag objects,
2596 or an empty list if there are no tags.
2597
2598 =cut
2599
2600 sub cust_tag {
2601   my $self = shift;
2602   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2603 }
2604
2605 =item part_tag
2606
2607 Returns any tags associated with this customer, as FS::part_tag objects,
2608 or an empty list if there are no tags.
2609
2610 =cut
2611
2612 sub part_tag {
2613   my $self = shift;
2614   map $_->part_tag, $self->cust_tag;
2615 }
2616
2617
2618 =item cust_class
2619
2620 Returns the customer class, as an FS::cust_class object, or the empty string
2621 if there is no customer class.
2622
2623 =cut
2624
2625 sub cust_class {
2626   my $self = shift;
2627   if ( $self->classnum ) {
2628     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2629   } else {
2630     return '';
2631   }
2632 }
2633
2634 =item categoryname
2635
2636 Returns the customer category name, or the empty string if there is no customer
2637 category.
2638
2639 =cut
2640
2641 sub categoryname {
2642   my $self = shift;
2643   my $cust_class = $self->cust_class;
2644   $cust_class
2645     ? $cust_class->categoryname
2646     : '';
2647 }
2648
2649 =item classname
2650
2651 Returns the customer class name, or the empty string if there is no customer
2652 class.
2653
2654 =cut
2655
2656 sub classname {
2657   my $self = shift;
2658   my $cust_class = $self->cust_class;
2659   $cust_class
2660     ? $cust_class->classname
2661     : '';
2662 }
2663
2664
2665 =item bill_and_collect
2666
2667 Cancels and suspends any packages due, generates bills, applies payments and
2668 credits, and applies collection events to run cards, send bills and notices,
2669 etc.
2670
2671 By default, warns on errors and continues with the next operation (but see the
2672 "fatal" flag below).
2673
2674 Options are passed as name-value pairs.  Currently available options are:
2675
2676 =over 4
2677
2678 =item time
2679
2680 Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
2681
2682  use Date::Parse;
2683  ...
2684  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2685
2686 =item invoice_time
2687
2688 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
2689
2690 =item check_freq
2691
2692 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
2693
2694 =item resetup
2695
2696 If set true, re-charges setup fees.
2697
2698 =item fatal
2699
2700 If set any errors prevent subsequent operations from continusing.  If set
2701 specifically to "return", returns the error (or false, if there is no error).
2702 Any other true value causes errors to die.
2703
2704 =item debug
2705
2706 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
2707
2708 =item job
2709
2710 Optional FS::queue entry to receive status updates.
2711
2712 =back
2713
2714 Options are passed to the B<bill> and B<collect> methods verbatim, so all
2715 options of those methods are also available.
2716
2717 =cut
2718
2719 sub bill_and_collect {
2720   my( $self, %options ) = @_;
2721
2722   my $error;
2723
2724   #$options{actual_time} not $options{time} because freeside-daily -d is for
2725   #pre-printing invoices
2726
2727   $options{'actual_time'} ||= time;
2728   my $job = $options{'job'};
2729
2730   $job->update_statustext('0,cleaning expired packages') if $job;
2731   $error = $self->cancel_expired_pkgs( $options{actual_time} );
2732   if ( $error ) {
2733     $error = "Error expiring custnum ". $self->custnum. ": $error";
2734     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2735     elsif ( $options{fatal}                                ) { die    $error; }
2736     else                                                     { warn   $error; }
2737   }
2738
2739   $error = $self->suspend_adjourned_pkgs( $options{actual_time} );
2740   if ( $error ) {
2741     $error = "Error adjourning custnum ". $self->custnum. ": $error";
2742     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2743     elsif ( $options{fatal}                                ) { die    $error; }
2744     else                                                     { warn   $error; }
2745   }
2746
2747   $job->update_statustext('20,billing packages') if $job;
2748   $error = $self->bill( %options );
2749   if ( $error ) {
2750     $error = "Error billing custnum ". $self->custnum. ": $error";
2751     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2752     elsif ( $options{fatal}                                ) { die    $error; }
2753     else                                                     { warn   $error; }
2754   }
2755
2756   $job->update_statustext('50,applying payments and credits') if $job;
2757   $error = $self->apply_payments_and_credits;
2758   if ( $error ) {
2759     $error = "Error applying custnum ". $self->custnum. ": $error";
2760     if    ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; }
2761     elsif ( $options{fatal}                                ) { die    $error; }
2762     else                                                     { warn   $error; }
2763   }
2764
2765   $job->update_statustext('70,running collection events') if $job;
2766   unless ( $conf->exists('cancelled_cust-noevents')
2767            && ! $self->num_ncancelled_pkgs
2768   ) {
2769     $error = $self->collect( %options );
2770     if ( $error ) {
2771       $error = "Error collecting custnum ". $self->custnum. ": $error";
2772       if    ($options{fatal} && $options{fatal} eq 'return') { return $error; }
2773       elsif ($options{fatal}                               ) { die    $error; }
2774       else                                                   { warn   $error; }
2775     }
2776   }
2777   $job->update_statustext('100,finished') if $job;
2778
2779   '';
2780
2781 }
2782
2783 sub cancel_expired_pkgs {
2784   my ( $self, $time, %options ) = @_;
2785
2786   my @cancel_pkgs = $self->ncancelled_pkgs( {
2787     'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time "
2788   } );
2789
2790   my @errors = ();
2791
2792   foreach my $cust_pkg ( @cancel_pkgs ) {
2793     my $cpr = $cust_pkg->last_cust_pkg_reason('expire');
2794     my $error = $cust_pkg->cancel($cpr ? ( 'reason'        => $cpr->reasonnum,
2795                                            'reason_otaker' => $cpr->otaker
2796                                          )
2797                                        : ()
2798                                  );
2799     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
2800   }
2801
2802   scalar(@errors) ? join(' / ', @errors) : '';
2803
2804 }
2805
2806 sub suspend_adjourned_pkgs {
2807   my ( $self, $time, %options ) = @_;
2808
2809   my @susp_pkgs = $self->ncancelled_pkgs( {
2810     'extra_sql' =>
2811       " AND ( susp IS NULL OR susp = 0 )
2812         AND (    ( bill    IS NOT NULL AND bill    != 0 AND bill    <  $time )
2813               OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time )
2814             )
2815       ",
2816   } );
2817
2818   #only because there's no SQL test for is_prepaid :/
2819   @susp_pkgs =
2820     grep {     (    $_->part_pkg->is_prepaid
2821                  && $_->bill
2822                  && $_->bill < $time
2823                )
2824             || (    $_->adjourn
2825                  && $_->adjourn <= $time
2826                )
2827
2828          }
2829          @susp_pkgs;
2830
2831   my @errors = ();
2832
2833   foreach my $cust_pkg ( @susp_pkgs ) {
2834     my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn')
2835       if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T);
2836     my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum,
2837                                             'reason_otaker' => $cpr->otaker
2838                                           )
2839                                         : ()
2840                                   );
2841     push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error;
2842   }
2843
2844   scalar(@errors) ? join(' / ', @errors) : '';
2845
2846 }
2847
2848 =item bill OPTIONS
2849
2850 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
2851 conjunction with the collect method by calling B<bill_and_collect>.
2852
2853 If there is an error, returns the error, otherwise returns false.
2854
2855 Options are passed as name-value pairs.  Currently available options are:
2856
2857 =over 4
2858
2859 =item resetup
2860
2861 If set true, re-charges setup fees.
2862
2863 =item time
2864
2865 Bills the customer as if it were that time.  Specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.  For example:
2866
2867  use Date::Parse;
2868  ...
2869  $cust_main->bill( 'time' => str2time('April 20th, 2001') );
2870
2871 =item pkg_list
2872
2873 An array ref of specific packages (objects) to attempt billing, instead trying all of them.
2874
2875  $cust_main->bill( pkg_list => [$pkg1, $pkg2] );
2876
2877 =item not_pkgpart
2878
2879 A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar).
2880
2881 =item invoice_time
2882
2883 Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices.  Other calculations, such as whether or not to generate the invoice in the first place, are not affected.
2884
2885 =item cancel
2886
2887 This boolean value informs the us that the package is being cancelled.  This
2888 typically might mean not charging the normal recurring fee but only usage
2889 fees since the last billing. Setup charges may be charged.  Not all package
2890 plans support this feature (they tend to charge 0).
2891
2892 =item invoice_terms
2893
2894 Optional terms to be printed on this invoice.  Otherwise, customer-specific
2895 terms or the default terms are used.
2896
2897 =back
2898
2899 =cut
2900
2901 sub bill {
2902   my( $self, %options ) = @_;
2903   return '' if $self->payby eq 'COMP';
2904   warn "$me bill customer ". $self->custnum. "\n"
2905     if $DEBUG;
2906
2907   my $time = $options{'time'} || time;
2908   my $invoice_time = $options{'invoice_time'} || $time;
2909
2910   $options{'not_pkgpart'} ||= {};
2911   $options{'not_pkgpart'} = { map { $_ => 1 }
2912                                   split(/\s*,\s*/, $options{'not_pkgpart'})
2913                             }
2914     unless ref($options{'not_pkgpart'});
2915
2916   local $SIG{HUP} = 'IGNORE';
2917   local $SIG{INT} = 'IGNORE';
2918   local $SIG{QUIT} = 'IGNORE';
2919   local $SIG{TERM} = 'IGNORE';
2920   local $SIG{TSTP} = 'IGNORE';
2921   local $SIG{PIPE} = 'IGNORE';
2922
2923   my $oldAutoCommit = $FS::UID::AutoCommit;
2924   local $FS::UID::AutoCommit = 0;
2925   my $dbh = dbh;
2926
2927   warn "$me acquiring lock on customer ". $self->custnum. "\n"
2928     if $DEBUG;
2929
2930   $self->select_for_update; #mutex
2931
2932   warn "$me running pre-bill events for customer ". $self->custnum. "\n"
2933     if $DEBUG;
2934
2935   my $error = $self->do_cust_event(
2936     'debug'      => ( $options{'debug'} || 0 ),
2937     'time'       => $invoice_time,
2938     'check_freq' => $options{'check_freq'},
2939     'stage'      => 'pre-bill',
2940   );
2941   if ( $error ) {
2942     $dbh->rollback if $oldAutoCommit;
2943     return $error;
2944   }
2945
2946   warn "$me done running pre-bill events for customer ". $self->custnum. "\n"
2947     if $DEBUG;
2948
2949   #keep auto-charge and non-auto-charge line items separate
2950   my @passes = ( '', 'no_auto' );
2951
2952   my %cust_bill_pkg = map { $_ => [] } @passes;
2953
2954   ###
2955   # find the packages which are due for billing, find out how much they are
2956   # & generate invoice database.
2957   ###
2958
2959   my %total_setup   = map { my $z = 0; $_ => \$z; } @passes;
2960   my %total_recur   = map { my $z = 0; $_ => \$z; } @passes;
2961
2962   my %taxlisthash = map { $_ => {} } @passes;
2963
2964   my @precommit_hooks = ();
2965
2966   $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ];  #param checks?
2967   foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) {
2968
2969     next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart};
2970
2971     warn "  bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1;
2972
2973     #? to avoid use of uninitialized value errors... ?
2974     $cust_pkg->setfield('bill', '')
2975       unless defined($cust_pkg->bill);
2976
2977     #my $part_pkg = $cust_pkg->part_pkg;
2978
2979     my $real_pkgpart = $cust_pkg->pkgpart;
2980     my %hash = $cust_pkg->hash;
2981
2982     # we could implement this bit as FS::part_pkg::has_hidden, but we already
2983     # suffer from performance issues
2984     $options{has_hidden} = 0;
2985     my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked;
2986     $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
2987
2988     foreach my $part_pkg ( @part_pkg ) {
2989
2990       $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill );
2991
2992       my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : '';
2993
2994       my $error =
2995         $self->_make_lines( 'part_pkg'            => $part_pkg,
2996                             'cust_pkg'            => $cust_pkg,
2997                             'precommit_hooks'     => \@precommit_hooks,
2998                             'line_items'          => $cust_bill_pkg{$pass},
2999                             'setup'               => $total_setup{$pass},
3000                             'recur'               => $total_recur{$pass},
3001                             'tax_matrix'          => $taxlisthash{$pass},
3002                             'time'                => $time,
3003                             'real_pkgpart'        => $real_pkgpart,
3004                             'options'             => \%options,
3005                           );
3006       if ($error) {
3007         $dbh->rollback if $oldAutoCommit;
3008         return $error;
3009       }
3010
3011     } #foreach my $part_pkg
3012
3013   } #foreach my $cust_pkg
3014
3015   #if the customer isn't on an automatic payby, everything can go on a single
3016   #invoice anyway?
3017   #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) {
3018     #merge everything into one list
3019   #}
3020
3021   foreach my $pass (@passes) { # keys %cust_bill_pkg ) {
3022
3023     my @cust_bill_pkg = @{ $cust_bill_pkg{$pass} };
3024
3025     next unless @cust_bill_pkg; #don't create an invoice w/o line items
3026
3027     if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) ||
3028            !$conf->exists('postal_invoice-recurring_only')
3029        )
3030     {
3031
3032       my $postal_pkg = $self->charge_postal_fee();
3033       if ( $postal_pkg && !ref( $postal_pkg ) ) {
3034
3035         $dbh->rollback if $oldAutoCommit;
3036         return "can't charge postal invoice fee for customer ".
3037           $self->custnum. ": $postal_pkg";
3038
3039       } elsif ( $postal_pkg ) {
3040
3041         my $real_pkgpart = $postal_pkg->pkgpart;
3042         # we could implement this bit as FS::part_pkg::has_hidden, but we already
3043         # suffer from performance issues
3044         $options{has_hidden} = 0;
3045         my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked;
3046         $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden);
3047
3048         foreach my $part_pkg ( @part_pkg ) {
3049           my %postal_options = %options;
3050           delete $postal_options{cancel};
3051           my $error =
3052             $self->_make_lines( 'part_pkg'            => $part_pkg,
3053                                 'cust_pkg'            => $postal_pkg,
3054                                 'precommit_hooks'     => \@precommit_hooks,
3055                                 'line_items'          => \@cust_bill_pkg,
3056                                 'setup'               => $total_setup{$pass},
3057                                 'recur'               => $total_recur{$pass},
3058                                 'tax_matrix'          => $taxlisthash{$pass},
3059                                 'time'                => $time,
3060                                 'real_pkgpart'        => $real_pkgpart,
3061                                 'options'             => \%postal_options,
3062                               );
3063           if ($error) {
3064             $dbh->rollback if $oldAutoCommit;
3065             return $error;
3066           }
3067         }
3068
3069       }
3070
3071     }
3072
3073     my $listref_or_error =
3074       $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time);
3075
3076     unless ( ref( $listref_or_error ) ) {
3077       $dbh->rollback if $oldAutoCommit;
3078       return $listref_or_error;
3079     }
3080
3081     foreach my $taxline ( @$listref_or_error ) {
3082       ${ $total_setup{$pass} } =
3083         sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup );
3084       push @cust_bill_pkg, $taxline;
3085     }
3086
3087     #add tax adjustments
3088     warn "adding tax adjustments...\n" if $DEBUG > 2;
3089     foreach my $cust_tax_adjustment (
3090       qsearch('cust_tax_adjustment', { 'custnum'    => $self->custnum,
3091                                        'billpkgnum' => '',
3092                                      }
3093              )
3094     ) {
3095
3096       my $tax = sprintf('%.2f', $cust_tax_adjustment->amount );
3097
3098       my $itemdesc = $cust_tax_adjustment->taxname;
3099       $itemdesc = '' if $itemdesc eq 'Tax';
3100
3101       push @cust_bill_pkg, new FS::cust_bill_pkg {
3102         'pkgnum'      => 0,
3103         'setup'       => $tax,
3104         'recur'       => 0,
3105         'sdate'       => '',
3106         'edate'       => '',
3107         'itemdesc'    => $itemdesc,
3108         'itemcomment' => $cust_tax_adjustment->comment,
3109         'cust_tax_adjustment' => $cust_tax_adjustment,
3110         #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
3111       };
3112
3113     }
3114
3115     my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } );
3116
3117     my @cust_bill = $self->cust_bill;
3118     my $balance = $self->balance;
3119     my $previous_balance = scalar(@cust_bill)
3120                              ? ( $cust_bill[$#cust_bill]->billing_balance || 0 )
3121                              : 0;
3122
3123     $previous_balance += $cust_bill[$#cust_bill]->charged
3124       if scalar(@cust_bill);
3125     #my $balance_adjustments =
3126     #  sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged);
3127
3128     #create the new invoice
3129     my $cust_bill = new FS::cust_bill ( {
3130       'custnum'             => $self->custnum,
3131       '_date'               => ( $invoice_time ),
3132       'charged'             => $charged,
3133       'billing_balance'     => $balance,
3134       'previous_balance'    => $previous_balance,
3135       'invoice_terms'       => $options{'invoice_terms'},
3136     } );
3137     $error = $cust_bill->insert;
3138     if ( $error ) {
3139       $dbh->rollback if $oldAutoCommit;
3140       return "can't create invoice for customer #". $self->custnum. ": $error";
3141     }
3142
3143     my @cust_bill_pkg_bundle = ();
3144     foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
3145       $cust_bill_pkg->invnum($cust_bill->invnum);
3146       if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) {
3147         $error = $self->_insert_cust_bill_pkg_bundle( @cust_bill_pkg_bundle );
3148         if ( $error ) {
3149           $dbh->rollback if $oldAutoCommit;
3150           return $error;
3151         }
3152         @cust_bill_pkg_bundle = ();
3153       }
3154       push @cust_bill_pkg_bundle, $cust_bill_pkg;
3155     }
3156     if (scalar(@cust_bill_pkg_bundle)) {
3157       $error = $self->_insert_cust_bill_pkg_bundle( @cust_bill_pkg_bundle );
3158       if ( $error ) {
3159         $dbh->rollback if $oldAutoCommit;
3160         return $error;
3161       }
3162     }
3163
3164   } #foreach my $pass ( keys %cust_bill_pkg )
3165
3166   foreach my $hook ( @precommit_hooks ) {
3167     eval {
3168       &{$hook}; #($self) ?
3169     };
3170     if ( $@ ) {
3171       $dbh->rollback if $oldAutoCommit;
3172       return "$@ running precommit hook $hook\n";
3173     }
3174   }
3175
3176   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3177   ''; #no error
3178 }
3179
3180 #insert line items while discarding bundled packages of 0 value
3181 sub _insert_cust_bill_pkg_bundle {
3182   my $self = shift;
3183   my @cust_bill_pkg = @_;
3184
3185   my $sum = 0;
3186   $sum += $_->setup + $_->recur foreach @cust_bill_pkg;
3187   return '' unless $sum > 0;
3188
3189   foreach my $cust_bill_pkg ( @cust_bill_pkg ) {
3190     my $error = $cust_bill_pkg->insert;
3191     return "can't create invoice line item: $error" if $error;
3192   }
3193
3194 }
3195
3196 =item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME
3197
3198 This is a weird one.  Perhaps it should not even be exposed.
3199
3200 Generates tax line items (see L<FS::cust_bill_pkg>) for this customer.
3201 Usually used internally by bill method B<bill>.
3202
3203 If there is an error, returns the error, otherwise returns reference to a
3204 list of line items suitable for insertion.
3205
3206 =over 4
3207
3208 =item LINEITEMREF
3209
3210 An array ref of the line items being billed.
3211
3212 =item TAXHASHREF
3213
3214 A strange beast.  The keys to this hash are internal identifiers consisting
3215 of the name of the tax object type, a space, and its unique identifier ( e.g.
3216  'cust_main_county 23' ).  The values of the hash are listrefs.  The first
3217 item in the list is the tax object.  The remaining items are either line
3218 items or floating point values (currency amounts).
3219
3220 The taxes are calculated on this entity.  Calculated exemption records are
3221 transferred to the LINEITEMREF items on the assumption that they are related.
3222
3223 Read the source.
3224
3225 =item INVOICE_TIME
3226
3227 This specifies the date appearing on the associated invoice.  Some
3228 jurisdictions (i.e. Texas) have tax exemptions which are date sensitive.
3229
3230 =back
3231
3232 =cut
3233 sub calculate_taxes {
3234   my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_;
3235
3236   my @tax_line_items = ();
3237
3238   warn "having a look at the taxes we found...\n" if $DEBUG > 2;
3239
3240   # keys are tax names (as printed on invoices / itemdesc )
3241   # values are listrefs of taxlisthash keys (internal identifiers)
3242   my %taxname = ();
3243
3244   # keys are taxlisthash keys (internal identifiers)
3245   # values are (cumulative) amounts
3246   my %tax = ();
3247
3248   # keys are taxlisthash keys (internal identifiers)
3249   # values are listrefs of cust_bill_pkg_tax_location hashrefs
3250   my %tax_location = ();
3251
3252   # keys are taxlisthash keys (internal identifiers)
3253   # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs
3254   my %tax_rate_location = ();
3255
3256   foreach my $tax ( keys %$taxlisthash ) {
3257     my $tax_object = shift @{ $taxlisthash->{$tax} };
3258     warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2;
3259     warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2;
3260     my $hashref_or_error =
3261       $tax_object->taxline( $taxlisthash->{$tax},
3262                             'custnum'      => $self->custnum,
3263                             'invoice_time' => $invoice_time
3264                           );
3265     return $hashref_or_error unless ref($hashref_or_error);
3266
3267     unshift @{ $taxlisthash->{$tax} }, $tax_object;
3268
3269     my $name   = $hashref_or_error->{'name'};
3270     my $amount = $hashref_or_error->{'amount'};
3271
3272     #warn "adding $amount as $name\n";
3273     $taxname{ $name } ||= [];
3274     push @{ $taxname{ $name } }, $tax;
3275
3276     $tax{ $tax } += $amount;
3277
3278     $tax_location{ $tax } ||= [];
3279     if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) {
3280       push @{ $tax_location{ $tax }  },
3281         {
3282           'taxnum'      => $tax_object->taxnum,
3283           'taxtype'     => ref($tax_object),
3284           'pkgnum'      => $tax_object->get('pkgnum'),
3285           'locationnum' => $tax_object->get('locationnum'),
3286           'amount'      => sprintf('%.2f', $amount ),
3287         };
3288     }
3289
3290     $tax_rate_location{ $tax } ||= [];
3291     if ( ref($tax_object) eq 'FS::tax_rate' ) {
3292       my $taxratelocationnum =
3293         $tax_object->tax_rate_location->taxratelocationnum;
3294       push @{ $tax_rate_location{ $tax }  },
3295         {
3296           'taxnum'             => $tax_object->taxnum,
3297           'taxtype'            => ref($tax_object),
3298           'amount'             => sprintf('%.2f', $amount ),
3299           'locationtaxid'      => $tax_object->location,
3300           'taxratelocationnum' => $taxratelocationnum,
3301         };
3302     }
3303
3304   }
3305
3306   #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit
3307   my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg;
3308   foreach my $tax ( keys %$taxlisthash ) {
3309     foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) {
3310       next unless ref($_) eq 'FS::cust_bill_pkg';
3311
3312       push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg },
3313         splice( @{ $_->_cust_tax_exempt_pkg } );
3314     }
3315   }
3316
3317   #consolidate and create tax line items
3318   warn "consolidating and generating...\n" if $DEBUG > 2;
3319   foreach my $taxname ( keys %taxname ) {
3320     my $tax = 0;
3321     my %seen = ();
3322     my @cust_bill_pkg_tax_location = ();
3323     my @cust_bill_pkg_tax_rate_location = ();
3324     warn "adding $taxname\n" if $DEBUG > 1;
3325     foreach my $taxitem ( @{ $taxname{$taxname} } ) {
3326       next if $seen{$taxitem}++;
3327       warn "adding $tax{$taxitem}\n" if $DEBUG > 1;
3328       $tax += $tax{$taxitem};
3329       push @cust_bill_pkg_tax_location,
3330         map { new FS::cust_bill_pkg_tax_location $_ }
3331             @{ $tax_location{ $taxitem } };
3332       push @cust_bill_pkg_tax_rate_location,
3333         map { new FS::cust_bill_pkg_tax_rate_location $_ }
3334             @{ $tax_rate_location{ $taxitem } };
3335     }
3336     next unless $tax;
3337
3338     $tax = sprintf('%.2f', $tax );
3339
3340     my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname,
3341                                                    'disabled'     => '',
3342                                                  },
3343                                );
3344
3345     my @display = ();
3346     if ( $pkg_category and
3347          $conf->config('invoice_latexsummary') ||
3348          $conf->config('invoice_htmlsummary')
3349        )
3350     {
3351
3352       my %hash = (  'section' => $pkg_category->categoryname );
3353       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
3354
3355     }
3356
3357     push @tax_line_items, new FS::cust_bill_pkg {
3358       'pkgnum'   => 0,
3359       'setup'    => $tax,
3360       'recur'    => 0,
3361       'sdate'    => '',
3362       'edate'    => '',
3363       'itemdesc' => $taxname,
3364       'display'  => \@display,
3365       'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location,
3366       'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location,
3367     };
3368
3369   }
3370
3371   \@tax_line_items;
3372 }
3373
3374 sub _make_lines {
3375   my ($self, %params) = @_;
3376
3377   my $part_pkg = $params{part_pkg} or die "no part_pkg specified";
3378   my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified";
3379   my $precommit_hooks = $params{precommit_hooks} or die "no package specified";
3380   my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified";
3381   my $total_setup = $params{setup} or die "no setup accumulator specified";
3382   my $total_recur = $params{recur} or die "no recur accumulator specified";
3383   my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified";
3384   my $time = $params{'time'} or die "no time specified";
3385   my (%options) = %{$params{options}};
3386
3387   my $dbh = dbh;
3388   my $real_pkgpart = $params{real_pkgpart};
3389   my %hash = $cust_pkg->hash;
3390   my $old_cust_pkg = new FS::cust_pkg \%hash;
3391
3392   my @details = ();
3393   my @discounts = ();
3394   my $lineitems = 0;
3395
3396   $cust_pkg->pkgpart($part_pkg->pkgpart);
3397
3398   ###
3399   # bill setup
3400   ###
3401
3402   my $setup = 0;
3403   my $unitsetup = 0;
3404   if ( $options{'resetup'}
3405        || ( ! $cust_pkg->setup
3406             && ( ! $cust_pkg->start_date
3407                  || $cust_pkg->start_date <= $time
3408                )
3409             && ( ! $conf->exists('disable_setup_suspended_pkgs')
3410                  || ( $conf->exists('disable_setup_suspended_pkgs') &&
3411                       ! $cust_pkg->getfield('susp')
3412                     )
3413                )
3414           )
3415     )
3416   {
3417
3418     warn "    bill setup\n" if $DEBUG > 1;
3419     $lineitems++;
3420
3421     $setup = eval { $cust_pkg->calc_setup( $time, \@details ) };
3422     return "$@ running calc_setup for $cust_pkg\n"
3423       if $@;
3424
3425     $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh
3426
3427     $cust_pkg->setfield('setup', $time)
3428       unless $cust_pkg->setup;
3429           #do need it, but it won't get written to the db
3430           #|| $cust_pkg->pkgpart != $real_pkgpart;
3431
3432     $cust_pkg->setfield('start_date', '')
3433       if $cust_pkg->start_date;
3434
3435   }
3436
3437   ###
3438   # bill recurring fee
3439   ###
3440
3441   #XXX unit stuff here too
3442   my $recur = 0;
3443   my $unitrecur = 0;
3444   my $sdate;
3445   if (     ! $cust_pkg->get('susp')
3446        and ! $cust_pkg->get('start_date')
3447        and ( $part_pkg->getfield('freq') ne '0'
3448              && ( $cust_pkg->getfield('bill') || 0 ) <= $time
3449            )
3450         || ( $part_pkg->plan eq 'voip_cdr'
3451               && $part_pkg->option('bill_every_call')
3452            )
3453         || ( $options{cancel} )
3454   ) {
3455
3456     # XXX should this be a package event?  probably.  events are called
3457     # at collection time at the moment, though...
3458     $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG)
3459       if $part_pkg->can('reset_usage');
3460       #don't want to reset usage just cause we want a line item??
3461       #&& $part_pkg->pkgpart == $real_pkgpart;
3462
3463     warn "    bill recur\n" if $DEBUG > 1;
3464     $lineitems++;
3465
3466     # XXX shared with $recur_prog
3467     $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill )
3468              || $cust_pkg->setup
3469              || $time;
3470
3471     #over two params!  lets at least switch to a hashref for the rest...
3472     my $increment_next_bill = ( $part_pkg->freq ne '0'
3473                                 && ( $cust_pkg->getfield('bill') || 0 ) <= $time
3474                                 && !$options{cancel}
3475                               );
3476     my %param = ( 'precommit_hooks'     => $precommit_hooks,
3477                   'increment_next_bill' => $increment_next_bill,
3478                   'discounts'           => \@discounts,
3479                 );
3480
3481     my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur';
3482     $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) };
3483     return "$@ running $method for $cust_pkg\n"
3484       if ( $@ );
3485
3486     if ( $increment_next_bill ) {
3487
3488       my $next_bill = $part_pkg->add_freq($sdate);
3489       return "unparsable frequency: ". $part_pkg->freq
3490         if $next_bill == -1;
3491
3492       #pro-rating magic - if $recur_prog fiddled $sdate, want to use that
3493       # only for figuring next bill date, nothing else, so, reset $sdate again
3494       # here
3495       $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
3496       #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill;
3497       $cust_pkg->last_bill($sdate);
3498
3499       $cust_pkg->setfield('bill', $next_bill );
3500
3501     }
3502
3503   }
3504
3505   warn "\$setup is undefined" unless defined($setup);
3506   warn "\$recur is undefined" unless defined($recur);
3507   warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill);
3508
3509   ###
3510   # If there's line items, create em cust_bill_pkg records
3511   # If $cust_pkg has been modified, update it (if we're a real pkgpart)
3512   ###
3513
3514   if ( $lineitems || $options{has_hidden} ) {
3515
3516     if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) {
3517       # hmm.. and if just the options are modified in some weird price plan?
3518
3519       warn "  package ". $cust_pkg->pkgnum. " modified; updating\n"
3520         if $DEBUG >1;
3521
3522       my $error = $cust_pkg->replace( $old_cust_pkg,
3523                                       'options' => { $cust_pkg->options },
3524                                     );
3525       return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"
3526         if $error; #just in case
3527     }
3528
3529     $setup = sprintf( "%.2f", $setup );
3530     $recur = sprintf( "%.2f", $recur );
3531     if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) {
3532       return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum;
3533     }
3534     if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) {
3535       return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum;
3536     }
3537
3538     if ( $setup != 0 ||
3539          $recur != 0 ||
3540          !$part_pkg->hidden && $options{has_hidden} ) #include some $0 lines
3541     {
3542
3543       warn "    charges (setup=$setup, recur=$recur); adding line items\n"
3544         if $DEBUG > 1;
3545
3546       my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I');
3547       if ( $DEBUG > 1 ) {
3548         warn "      adding customer package invoice detail: $_\n"
3549           foreach @cust_pkg_detail;
3550       }
3551       push @details, @cust_pkg_detail;
3552
3553       my $cust_bill_pkg = new FS::cust_bill_pkg {
3554         'pkgnum'    => $cust_pkg->pkgnum,
3555         'setup'     => $setup,
3556         'unitsetup' => $unitsetup,
3557         'recur'     => $recur,
3558         'unitrecur' => $unitrecur,
3559         'quantity'  => $cust_pkg->quantity,
3560         'details'   => \@details,
3561         'discounts' => \@discounts,
3562         'hidden'    => $part_pkg->hidden,
3563       };
3564
3565       if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) {
3566         $cust_bill_pkg->sdate( $hash{last_bill} );
3567         $cust_bill_pkg->edate( $sdate - 86399   ); #60s*60m*24h-1
3568         $cust_bill_pkg->edate( $time ) if $options{cancel};
3569       } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) {
3570         $cust_bill_pkg->sdate( $sdate );
3571         $cust_bill_pkg->edate( $cust_pkg->bill );
3572         #$cust_bill_pkg->edate( $time ) if $options{cancel};
3573       }
3574
3575       $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart)
3576         unless $part_pkg->pkgpart == $real_pkgpart;
3577
3578       $$total_setup += $setup;
3579       $$total_recur += $recur;
3580
3581       ###
3582       # handle taxes
3583       ###
3584
3585       my $error =
3586         $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options);
3587       return $error if $error;
3588
3589       push @$cust_bill_pkgs, $cust_bill_pkg;
3590
3591     } #if $setup != 0 || $recur != 0
3592
3593   } #if $line_items
3594
3595   '';
3596
3597 }
3598
3599 sub _handle_taxes {
3600   my $self = shift;
3601   my $part_pkg = shift;
3602   my $taxlisthash = shift;
3603   my $cust_bill_pkg = shift;
3604   my $cust_pkg = shift;
3605   my $invoice_time = shift;
3606   my $real_pkgpart = shift;
3607   my $options = shift;
3608
3609   my %cust_bill_pkg = ();
3610   my %taxes = ();
3611
3612   my @classes;
3613   #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U';
3614   push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage;
3615   push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel});
3616   push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel});
3617
3618   if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) {
3619
3620     if ( $conf->exists('enable_taxproducts')
3621          && ( scalar($part_pkg->part_pkg_taxoverride)
3622               || $part_pkg->has_taxproduct
3623             )
3624        )
3625     {
3626
3627       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3628         return "fatal: Can't (yet) use tax-pkg_address with taxproducts";
3629       }
3630
3631       foreach my $class (@classes) {
3632         my $err_or_ref = $self->_gather_taxes( $part_pkg, $class );
3633         return $err_or_ref unless ref($err_or_ref);
3634         $taxes{$class} = $err_or_ref;
3635       }
3636
3637       unless (exists $taxes{''}) {
3638         my $err_or_ref = $self->_gather_taxes( $part_pkg, '' );
3639         return $err_or_ref unless ref($err_or_ref);
3640         $taxes{''} = $err_or_ref;
3641       }
3642
3643     } else {
3644
3645       my @loc_keys = qw( city county state country );
3646       my %taxhash;
3647       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3648         my $cust_location = $cust_pkg->cust_location;
3649         %taxhash = map { $_ => $cust_location->$_()    } @loc_keys;
3650       } else {
3651         my $prefix =
3652           ( $conf->exists('tax-ship_address') && length($self->ship_last) )
3653           ? 'ship_'
3654           : '';
3655         %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys;
3656       }
3657
3658       $taxhash{'taxclass'} = $part_pkg->taxclass;
3659
3660       my @taxes = ();
3661       my %taxhash_elim = %taxhash;
3662       my @elim = qw( city county state );
3663       do {
3664
3665         #first try a match with taxclass
3666         @taxes = qsearch( 'cust_main_county', \%taxhash_elim );
3667
3668         if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) {
3669           #then try a match without taxclass
3670           my %no_taxclass = %taxhash_elim;
3671           $no_taxclass{ 'taxclass' } = '';
3672           @taxes = qsearch( 'cust_main_county', \%no_taxclass );
3673         }
3674
3675         $taxhash_elim{ shift(@elim) } = '';
3676
3677       } while ( !scalar(@taxes) && scalar(@elim) );
3678
3679       @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) }
3680                     @taxes
3681         if $self->cust_main_exemption; #just to be safe
3682
3683       if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) {
3684         foreach (@taxes) {
3685           $_->set('pkgnum',      $cust_pkg->pkgnum );
3686           $_->set('locationnum', $cust_pkg->locationnum );
3687         }
3688       }
3689
3690       $taxes{''} = [ @taxes ];
3691       $taxes{'setup'} = [ @taxes ];
3692       $taxes{'recur'} = [ @taxes ];
3693       $taxes{$_} = [ @taxes ] foreach (@classes);
3694
3695       # # maybe eliminate this entirely, along with all the 0% records
3696       # unless ( @taxes ) {
3697       #   return
3698       #     "fatal: can't find tax rate for state/county/country/taxclass ".
3699       #     join('/', map $taxhash{$_}, qw(state county country taxclass) );
3700       # }
3701
3702     } #if $conf->exists('enable_taxproducts') ...
3703
3704   }
3705
3706   my @display = ();
3707   my $separate = $conf->exists('separate_usage');
3708   my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart };
3709   my $usage_mandate = $temp_pkg->part_pkg->option('usage_mandate', 'Hush!');
3710   my $section = $temp_pkg->part_pkg->categoryname;
3711   if ( $separate || $section || $usage_mandate ) {
3712
3713     my %hash = ( 'section' => $section );
3714
3715     $section = $temp_pkg->part_pkg->option('usage_section', 'Hush!');
3716     my $summary = $temp_pkg->part_pkg->option('summarize_usage', 'Hush!');
3717     if ( $separate ) {
3718       push @display, new FS::cust_bill_pkg_display { type => 'S', %hash };
3719       push @display, new FS::cust_bill_pkg_display { type => 'R', %hash };
3720     } else {
3721       push @display, new FS::cust_bill_pkg_display
3722                        { type => '',
3723                          %hash,
3724                          ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ),
3725                        };
3726     }
3727
3728     if ($separate && $section && $summary) {
3729       push @display, new FS::cust_bill_pkg_display { type    => 'U',
3730                                                      summary => 'Y',
3731                                                      %hash,
3732                                                    };
3733     }
3734     if ($usage_mandate || $section && $summary) {
3735       $hash{post_total} = 'Y';
3736     }
3737
3738     if ($separate || $usage_mandate) {
3739       $hash{section} = $section if ($separate || $usage_mandate);
3740       push @display, new FS::cust_bill_pkg_display { type => 'U', %hash };
3741     }
3742
3743   }
3744   $cust_bill_pkg->set('display', \@display);
3745
3746   my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate;
3747   foreach my $key (keys %tax_cust_bill_pkg) {
3748     my @taxes = @{ $taxes{$key} || [] };
3749     my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key};
3750
3751     my %localtaxlisthash = ();
3752     foreach my $tax ( @taxes ) {
3753
3754       my $taxname = ref( $tax ). ' '. $tax->taxnum;
3755 #      $taxname .= ' pkgnum'. $cust_pkg->pkgnum.
3756 #                  ' locationnum'. $cust_pkg->locationnum
3757 #        if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum;
3758
3759       $taxlisthash->{ $taxname } ||= [ $tax ];
3760       push @{ $taxlisthash->{ $taxname  } }, $tax_cust_bill_pkg;
3761
3762       $localtaxlisthash{ $taxname } ||= [ $tax ];
3763       push @{ $localtaxlisthash{ $taxname  } }, $tax_cust_bill_pkg;
3764
3765     }
3766
3767     warn "finding taxed taxes...\n" if $DEBUG > 2;
3768     foreach my $tax ( keys %localtaxlisthash ) {
3769       my $tax_object = shift @{ $localtaxlisthash{$tax} };
3770       warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n"
3771         if $DEBUG > 2;
3772       next unless $tax_object->can('tax_on_tax');
3773
3774       foreach my $tot ( $tax_object->tax_on_tax( $self ) ) {
3775         my $totname = ref( $tot ). ' '. $tot->taxnum;
3776
3777         warn "checking $totname which we call ". $tot->taxname. " as applicable\n"
3778           if $DEBUG > 2;
3779         next unless exists( $localtaxlisthash{ $totname } ); # only increase
3780                                                              # existing taxes
3781         warn "adding $totname to taxed taxes\n" if $DEBUG > 2;
3782         my $hashref_or_error =
3783           $tax_object->taxline( $localtaxlisthash{$tax},
3784                                 'custnum'      => $self->custnum,
3785                                 'invoice_time' => $invoice_time,
3786                               );
3787         return $hashref_or_error
3788           unless ref($hashref_or_error);
3789
3790         $taxlisthash->{ $totname } ||= [ $tot ];
3791         push @{ $taxlisthash->{ $totname  } }, $hashref_or_error->{amount};
3792
3793       }
3794     }
3795
3796   }
3797
3798   '';
3799 }
3800
3801 sub _gather_taxes {
3802   my $self = shift;
3803   my $part_pkg = shift;
3804   my $class = shift;
3805
3806   my @taxes = ();
3807   my $geocode = $self->geocode('cch');
3808
3809   my @taxclassnums = map { $_->taxclassnum }
3810                      $part_pkg->part_pkg_taxoverride($class);
3811
3812   unless (@taxclassnums) {
3813     @taxclassnums = map { $_->taxclassnum }
3814                     grep { $_->taxable eq 'Y' }
3815                     $part_pkg->part_pkg_taxrate('cch', $geocode, $class);
3816   }
3817   warn "Found taxclassnum values of ". join(',', @taxclassnums)
3818     if $DEBUG;
3819
3820   my $extra_sql =
3821     "AND (".
3822     join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")";
3823
3824   @taxes = qsearch({ 'table' => 'tax_rate',
3825                      'hashref' => { 'geocode' => $geocode, },
3826                      'extra_sql' => $extra_sql,
3827                   })
3828     if scalar(@taxclassnums);
3829
3830   warn "Found taxes ".
3831        join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n"
3832    if $DEBUG;
3833
3834   [ @taxes ];
3835
3836 }
3837
3838 =item collect [ HASHREF | OPTION => VALUE ... ]
3839
3840 (Attempt to) collect money for this customer's outstanding invoices (see
3841 L<FS::cust_bill>).  Usually used after the bill method.
3842
3843 Actions are now triggered by billing events; see L<FS::part_event> and the
3844 billing events web interface.  Old-style invoice events (see
3845 L<FS::part_bill_event>) have been deprecated.
3846
3847 If there is an error, returns the error, otherwise returns false.
3848
3849 Options are passed as name-value pairs.
3850
3851 Currently available options are:
3852
3853 =over 4
3854
3855 =item invoice_time
3856
3857 Use this time when deciding when to print invoices and late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
3858
3859 =item retry
3860
3861 Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3862
3863 =item check_freq
3864
3865 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3866
3867 =item quiet
3868
3869 set true to surpress email card/ACH decline notices.
3870
3871 =item debug
3872
3873 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
3874
3875 =back
3876
3877 # =item payby
3878 #
3879 # allows for one time override of normal customer billing method
3880
3881 =cut
3882
3883 sub collect {
3884   my( $self, %options ) = @_;
3885   my $invoice_time = $options{'invoice_time'} || time;
3886
3887   #put below somehow?
3888   local $SIG{HUP} = 'IGNORE';
3889   local $SIG{INT} = 'IGNORE';
3890   local $SIG{QUIT} = 'IGNORE';
3891   local $SIG{TERM} = 'IGNORE';
3892   local $SIG{TSTP} = 'IGNORE';
3893   local $SIG{PIPE} = 'IGNORE';
3894
3895   my $oldAutoCommit = $FS::UID::AutoCommit;
3896   local $FS::UID::AutoCommit = 0;
3897   my $dbh = dbh;
3898
3899   $self->select_for_update; #mutex
3900
3901   if ( $DEBUG ) {
3902     my $balance = $self->balance;
3903     warn "$me collect customer ". $self->custnum. ": balance $balance\n"
3904   }
3905
3906   if ( exists($options{'retry_card'}) ) {
3907     carp 'retry_card option passed to collect is deprecated; use retry';
3908     $options{'retry'} ||= $options{'retry_card'};
3909   }
3910   if ( exists($options{'retry'}) && $options{'retry'} ) {
3911     my $error = $self->retry_realtime;
3912     if ( $error ) {
3913       $dbh->rollback if $oldAutoCommit;
3914       return $error;
3915     }
3916   }
3917
3918   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3919
3920   #never want to roll back an event just because it returned an error
3921   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
3922
3923   $self->do_cust_event(
3924     'debug'      => ( $options{'debug'} || 0 ),
3925     'time'       => $invoice_time,
3926     'check_freq' => $options{'check_freq'},
3927     'stage'      => 'collect',
3928   );
3929
3930 }
3931
3932 =item do_cust_event [ HASHREF | OPTION => VALUE ... ]
3933
3934 Runs billing events; see L<FS::part_event> and the billing events web
3935 interface.
3936
3937 If there is an error, returns the error, otherwise returns false.
3938
3939 Options are passed as name-value pairs.
3940
3941 Currently available options are:
3942
3943 =over 4
3944
3945 =item time
3946
3947 Use this time when deciding when to print invoices and late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion functions.
3948
3949 =item check_freq
3950
3951 "1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq)
3952
3953 =item stage
3954
3955 "collect" (the default) or "pre-bill"
3956
3957 =item quiet
3958
3959 set true to surpress email card/ACH decline notices.
3960
3961 =item debug
3962
3963 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
3964
3965 =cut
3966
3967 # =item payby
3968 #
3969 # allows for one time override of normal customer billing method
3970
3971 # =item retry
3972 #
3973 # Retry card/echeck/LEC transactions even when not scheduled by invoice events.
3974
3975 sub do_cust_event {
3976   my( $self, %options ) = @_;
3977   my $time = $options{'time'} || time;
3978
3979   #put below somehow?
3980   local $SIG{HUP} = 'IGNORE';
3981   local $SIG{INT} = 'IGNORE';
3982   local $SIG{QUIT} = 'IGNORE';
3983   local $SIG{TERM} = 'IGNORE';
3984   local $SIG{TSTP} = 'IGNORE';
3985   local $SIG{PIPE} = 'IGNORE';
3986
3987   my $oldAutoCommit = $FS::UID::AutoCommit;
3988   local $FS::UID::AutoCommit = 0;
3989   my $dbh = dbh;
3990
3991   $self->select_for_update; #mutex
3992
3993   if ( $DEBUG ) {
3994     my $balance = $self->balance;
3995     warn "$me do_cust_event customer ". $self->custnum. ": balance $balance\n"
3996   }
3997
3998 #  if ( exists($options{'retry_card'}) ) {
3999 #    carp 'retry_card option passed to collect is deprecated; use retry';
4000 #    $options{'retry'} ||= $options{'retry_card'};
4001 #  }
4002 #  if ( exists($options{'retry'}) && $options{'retry'} ) {
4003 #    my $error = $self->retry_realtime;
4004 #    if ( $error ) {
4005 #      $dbh->rollback if $oldAutoCommit;
4006 #      return $error;
4007 #    }
4008 #  }
4009
4010   # false laziness w/pay_batch::import_results
4011
4012   my $due_cust_event = $self->due_cust_event(
4013     'debug'      => ( $options{'debug'} || 0 ),
4014     'time'       => $time,
4015     'check_freq' => $options{'check_freq'},
4016     'stage'      => ( $options{'stage'} || 'collect' ),
4017   );
4018   unless( ref($due_cust_event) ) {
4019     $dbh->rollback if $oldAutoCommit;
4020     return $due_cust_event;
4021   }
4022
4023   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4024   #never want to roll back an event just because it or a different one
4025   # returned an error
4026   local $FS::UID::AutoCommit = 1; #$oldAutoCommit;
4027
4028   foreach my $cust_event ( @$due_cust_event ) {
4029
4030     #XXX lock event
4031
4032     #re-eval event conditions (a previous event could have changed things)
4033     unless ( $cust_event->test_conditions( 'time' => $time ) ) {
4034       #don't leave stray "new/locked" records around
4035       my $error = $cust_event->delete;
4036       return $error if $error;
4037       next;
4038     }
4039
4040     {
4041       local $realtime_bop_decline_quiet = 1 if $options{'quiet'};
4042       warn "  running cust_event ". $cust_event->eventnum. "\n"
4043         if $DEBUG > 1;
4044
4045       #if ( my $error = $cust_event->do_event(%options) ) { #XXX %options?
4046       if ( my $error = $cust_event->do_event() ) {
4047         #XXX wtf is this?  figure out a proper dealio with return value
4048         #from do_event
4049         return $error;
4050       }
4051     }
4052
4053   }
4054
4055   '';
4056
4057 }
4058
4059 =item due_cust_event [ HASHREF | OPTION => VALUE ... ]
4060
4061 Inserts database records for and returns an ordered listref of new events due
4062 for this customer, as FS::cust_event objects (see L<FS::cust_event>).  If no
4063 events are due, an empty listref is returned.  If there is an error, returns a
4064 scalar error message.
4065
4066 To actually run the events, call each event's test_condition method, and if
4067 still true, call the event's do_event method.
4068
4069 Options are passed as a hashref or as a list of name-value pairs.  Available
4070 options are:
4071
4072 =over 4
4073
4074 =item check_freq
4075
4076 Search only for events of this check frequency (how often events of this type are checked); currently "1d" (daily, the default) and "1m" (monthly) are recognized.
4077
4078 =item stage
4079
4080 "collect" (the default) or "pre-bill"
4081
4082 =item time
4083
4084 "Current time" for the events.
4085
4086 =item debug
4087
4088 Debugging level.  Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries)
4089
4090 =item eventtable
4091
4092 Only return events for the specified eventtable (by default, events of all eventtables are returned)
4093
4094 =item objects
4095
4096 Explicitly pass the objects to be tested (typically used with eventtable).
4097
4098 =item testonly
4099
4100 Set to true to return the objects, but not actually insert them into the
4101 database.
4102
4103 =back
4104
4105 =cut
4106
4107 sub due_cust_event {
4108   my $self = shift;
4109   my %opt = ref($_[0]) ? %{ $_[0] } : @_;
4110
4111   #???
4112   #my $DEBUG = $opt{'debug'}
4113   local($DEBUG) = $opt{'debug'}
4114     if defined($opt{'debug'}) && $opt{'debug'} > $DEBUG;
4115
4116   warn "$me due_cust_event called with options ".
4117        join(', ', map { "$_: $opt{$_}" } keys %opt). "\n"
4118     if $DEBUG;
4119
4120   $opt{'time'} ||= time;
4121
4122   local $SIG{HUP} = 'IGNORE';
4123   local $SIG{INT} = 'IGNORE';
4124   local $SIG{QUIT} = 'IGNORE';
4125   local $SIG{TERM} = 'IGNORE';
4126   local $SIG{TSTP} = 'IGNORE';
4127   local $SIG{PIPE} = 'IGNORE';
4128
4129   my $oldAutoCommit = $FS::UID::AutoCommit;
4130   local $FS::UID::AutoCommit = 0;
4131   my $dbh = dbh;
4132
4133   $self->select_for_update #mutex
4134     unless $opt{testonly};
4135
4136   ###
4137   # find possible events (initial search)
4138   ###
4139
4140   my @cust_event = ();
4141
4142   my @eventtable = $opt{'eventtable'}
4143                      ? ( $opt{'eventtable'} )
4144                      : FS::part_event->eventtables_runorder;
4145
4146   foreach my $eventtable ( @eventtable ) {
4147
4148     my @objects;
4149     if ( $opt{'objects'} ) {
4150
4151       @objects = @{ $opt{'objects'} };
4152
4153     } else {
4154
4155       #my @objects = $self->eventtable(); # sub cust_main { @{ [ $self ] }; }
4156       @objects = ( $eventtable eq 'cust_main' )
4157                    ? ( $self )
4158                    : ( $self->$eventtable() );
4159
4160     }
4161
4162     my @e_cust_event = ();
4163
4164     my $cross = "CROSS JOIN $eventtable";
4165     $cross .= ' LEFT JOIN cust_main USING ( custnum )'
4166       unless $eventtable eq 'cust_main';
4167
4168     foreach my $object ( @objects ) {
4169
4170       #this first search uses the condition_sql magic for optimization.
4171       #the more possible events we can eliminate in this step the better
4172
4173       my $cross_where = '';
4174       my $pkey = $object->primary_key;
4175       $cross_where = "$eventtable.$pkey = ". $object->$pkey();
4176
4177       my $join = FS::part_event_condition->join_conditions_sql( $eventtable );
4178       my $extra_sql =
4179         FS::part_event_condition->where_conditions_sql( $eventtable,
4180                                                         'time'=>$opt{'time'}
4181                                                       );
4182       my $order = FS::part_event_condition->order_conditions_sql( $eventtable );
4183
4184       $extra_sql = "AND $extra_sql" if $extra_sql;
4185
4186       #here is the agent virtualization
4187       $extra_sql .= " AND (    part_event.agentnum IS NULL
4188                             OR part_event.agentnum = ". $self->agentnum. ' )';
4189
4190       $extra_sql .= " $order";
4191
4192       warn "searching for events for $eventtable ". $object->$pkey. "\n"
4193         if $opt{'debug'} > 2;
4194       my @part_event = qsearch( {
4195         'debug'     => ( $opt{'debug'} > 3 ? 1 : 0 ),
4196         'select'    => 'part_event.*',
4197         'table'     => 'part_event',
4198         'addl_from' => "$cross $join",
4199         'hashref'   => { 'check_freq' => ( $opt{'check_freq'} || '1d' ),
4200                          'eventtable' => $eventtable,
4201                          'disabled'   => '',
4202                        },
4203         'extra_sql' => "AND $cross_where $extra_sql",
4204       } );
4205
4206       if ( $DEBUG > 2 ) {
4207         my $pkey = $object->primary_key;
4208         warn "      ". scalar(@part_event).
4209              " possible events found for $eventtable ". $object->$pkey(). "\n";
4210       }
4211
4212       push @e_cust_event, map { $_->new_cust_event($object) } @part_event;
4213
4214     }
4215
4216     warn "    ". scalar(@e_cust_event).
4217          " subtotal possible cust events found for $eventtable\n"
4218       if $DEBUG > 1;
4219
4220     push @cust_event, @e_cust_event;
4221
4222   }
4223
4224   warn "  ". scalar(@cust_event).
4225        " total possible cust events found in initial search\n"
4226     if $DEBUG; # > 1;
4227
4228
4229   ##
4230   # test stage
4231   ##
4232
4233   $opt{stage} ||= 'collect';
4234   @cust_event =
4235     grep { my $stage = $_->part_event->event_stage;
4236            $opt{stage} eq $stage or ( ! $stage && $opt{stage} eq 'collect' )
4237          }
4238          @cust_event;
4239
4240   ##
4241   # test conditions
4242   ##
4243
4244   my %unsat = ();
4245
4246   @cust_event = grep $_->test_conditions( 'time'          => $opt{'time'},
4247                                           'stats_hashref' => \%unsat ),
4248                      @cust_event;
4249
4250   warn "  ". scalar(@cust_event). " cust events left satisfying conditions\n"
4251     if $DEBUG; # > 1;
4252
4253   warn "    invalid conditions not eliminated with condition_sql:\n".
4254        join('', map "      $_: ".$unsat{$_}."\n", keys %unsat )
4255     if keys %unsat && $DEBUG; # > 1;
4256
4257   ##
4258   # insert
4259   ##
4260
4261   unless( $opt{testonly} ) {
4262     foreach my $cust_event ( @cust_event ) {
4263
4264       my $error = $cust_event->insert();
4265       if ( $error ) {
4266         $dbh->rollback if $oldAutoCommit;
4267         return $error;
4268       }
4269
4270     }
4271   }
4272
4273   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4274
4275   ##
4276   # return
4277   ##
4278
4279   warn "  returning events: ". Dumper(@cust_event). "\n"
4280     if $DEBUG > 2;
4281
4282   \@cust_event;
4283
4284 }
4285
4286 =item retry_realtime
4287
4288 Schedules realtime / batch  credit card / electronic check / LEC billing
4289 events for for retry.  Useful if card information has changed or manual
4290 retry is desired.  The 'collect' method must be called to actually retry
4291 the transaction.
4292
4293 Implementation details: For either this customer, or for each of this
4294 customer's open invoices, changes the status of the first "done" (with
4295 statustext error) realtime processing event to "failed".
4296
4297 =cut
4298
4299 sub retry_realtime {
4300   my $self = shift;
4301
4302   local $SIG{HUP} = 'IGNORE';
4303   local $SIG{INT} = 'IGNORE';
4304   local $SIG{QUIT} = 'IGNORE';
4305   local $SIG{TERM} = 'IGNORE';
4306   local $SIG{TSTP} = 'IGNORE';
4307   local $SIG{PIPE} = 'IGNORE';
4308
4309   my $oldAutoCommit = $FS::UID::AutoCommit;
4310   local $FS::UID::AutoCommit = 0;
4311   my $dbh = dbh;
4312
4313   #a little false laziness w/due_cust_event (not too bad, really)
4314
4315   my $join = FS::part_event_condition->join_conditions_sql;
4316   my $order = FS::part_event_condition->order_conditions_sql;
4317   my $mine =
4318   '( '
4319    . join ( ' OR ' , map {
4320     "( part_event.eventtable = " . dbh->quote($_)
4321     . " AND tablenum IN( SELECT " . dbdef->table($_)->primary_key . " from $_ where custnum = " . dbh->quote( $self->custnum ) . "))" ;
4322    } FS::part_event->eventtables)
4323    . ') ';
4324
4325   #here is the agent virtualization
4326   my $agent_virt = " (    part_event.agentnum IS NULL
4327                        OR part_event.agentnum = ". $self->agentnum. ' )';
4328
4329   #XXX this shouldn't be hardcoded, actions should declare it...
4330   my @realtime_events = qw(
4331     cust_bill_realtime_card
4332     cust_bill_realtime_check
4333     cust_bill_realtime_lec
4334     cust_bill_batch
4335   );
4336
4337   my $is_realtime_event = ' ( '. join(' OR ', map "part_event.action = '$_'",
4338                                                   @realtime_events
4339                                      ).
4340                           ' ) ';
4341
4342   my @cust_event = qsearchs({
4343     'table'     => 'cust_event',
4344     'select'    => 'cust_event.*',
4345     'addl_from' => "LEFT JOIN part_event USING ( eventpart ) $join",
4346     'hashref'   => { 'status' => 'done' },
4347     'extra_sql' => " AND statustext IS NOT NULL AND statustext != '' ".
4348                    " AND $mine AND $is_realtime_event AND $agent_virt $order" # LIMIT 1"
4349   });
4350
4351   my %seen_invnum = ();
4352   foreach my $cust_event (@cust_event) {
4353
4354     #max one for the customer, one for each open invoice
4355     my $cust_X = $cust_event->cust_X;
4356     next if $seen_invnum{ $cust_event->part_event->eventtable eq 'cust_bill'
4357                           ? $cust_X->invnum
4358                           : 0
4359                         }++
4360          or $cust_event->part_event->eventtable eq 'cust_bill'
4361             && ! $cust_X->owed;
4362
4363     my $error = $cust_event->retry;
4364     if ( $error ) {
4365       $dbh->rollback if $oldAutoCommit;
4366       return "error scheduling event for retry: $error";
4367     }
4368
4369   }
4370
4371   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4372   '';
4373
4374 }
4375
4376
4377 =cut
4378
4379 =item realtime_collect [ OPTION => VALUE ... ]
4380
4381 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4382 via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime
4383 gateway.  See L<http://420.am/business-onlinepayment> and
4384 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
4385
4386 On failure returns an error message.
4387
4388 Returns false or a hashref upon success.  The hashref contains keys popup_url reference, and collectitems.  The first is a URL to which a browser should be redirected for completion of collection.  The second is a reference id for the transaction suitable for the end user.  The collectitems is a reference to a list of name value pairs suitable for assigning to a html form and posted to popup_url.
4389
4390 Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum>
4391
4392 I<method> is one of: I<CC>, I<ECHECK> and I<LEC>.  If none is specified
4393 then it is deduced from the customer record.
4394
4395 If no I<amount> is specified, then the customer balance is used.
4396
4397 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4398 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4399 if set, will override the value from the customer record.
4400
4401 I<description> is a free-text field passed to the gateway.  It defaults to
4402 the value defined by the business-onlinepayment-description configuration
4403 option, or "Internet services" if that is unset.
4404
4405 If an I<invnum> is specified, this payment (if successful) is applied to the
4406 specified invoice.  If you don't specify an I<invnum> you might want to
4407 call the B<apply_payments> method or set the I<apply> option.
4408
4409 I<apply> can be set to true to apply a resulting payment.
4410
4411 I<quiet> can be set true to surpress email decline notices.
4412
4413 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4414 resulting paynum, if any.
4415
4416 I<payunique> is a unique identifier for this payment.
4417
4418 I<session_id> is a session identifier associated with this payment.
4419
4420 I<depend_jobnum> allows payment capture to unlock export jobs
4421
4422 =cut
4423
4424 sub realtime_collect {
4425   my( $self, %options ) = @_;
4426
4427   if ( $DEBUG ) {
4428     warn "$me realtime_collect:\n";
4429     warn "  $_ => $options{$_}\n" foreach keys %options;
4430   }
4431
4432   $options{amount} = $self->balance unless exists( $options{amount} );
4433   $options{method} = FS::payby->payby2bop($self->payby)
4434     unless exists( $options{method} );
4435
4436   return $self->realtime_bop({%options});
4437
4438 }
4439
4440 =item realtime_bop { [ ARG => VALUE ... ] }
4441
4442 Runs a realtime credit card, ACH (electronic check) or phone bill transaction
4443 via a Business::OnlinePayment realtime gateway.  See
4444 L<http://420.am/business-onlinepayment> for supported gateways.
4445
4446 Required arguments in the hashref are I<method>, and I<amount>
4447
4448 Available methods are: I<CC>, I<ECHECK> and I<LEC>
4449
4450 Available optional arguments are: I<description>, I<invnum>, I<apply>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>
4451
4452 The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
4453 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
4454 if set, will override the value from the customer record.
4455
4456 I<description> is a free-text field passed to the gateway.  It defaults to
4457 the value defined by the business-onlinepayment-description configuration
4458 option, or "Internet services" if that is unset.
4459
4460 If an I<invnum> is specified, this payment (if successful) is applied to the
4461 specified invoice.  If you don't specify an I<invnum> you might want to
4462 call the B<apply_payments> method or set the I<apply> option.
4463
4464 I<apply> can be set to true to apply a resulting payment.
4465
4466 I<quiet> can be set true to surpress email decline notices.
4467
4468 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
4469 resulting paynum, if any.
4470
4471 I<payunique> is a unique identifier for this payment.
4472
4473 I<session_id> is a session identifier associated with this payment.
4474
4475 I<depend_jobnum> allows payment capture to unlock export jobs
4476
4477 (moved from cust_bill) (probably should get realtime_{card,ach,lec} here too)
4478
4479 =cut
4480
4481 # some helper routines
4482 sub _bop_recurring_billing {
4483   my( $self, %opt ) = @_;
4484
4485   my $method = scalar($conf->config('credit_card-recurring_billing_flag'));
4486
4487   if ( defined($method) && $method eq 'transaction_is_recur' ) {
4488
4489     return 1 if $opt{'trans_is_recur'};
4490
4491   } else {
4492
4493     my %hash = ( 'custnum' => $self->custnum,
4494                  'payby'   => 'CARD',
4495                );
4496
4497     return 1
4498       if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } )
4499       || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD',
4500                                                                $opt{'payinfo'} )
4501                              } );
4502
4503   }
4504
4505   return 0;
4506
4507 }
4508
4509 sub _payment_gateway {
4510   my ($self, $options) = @_;
4511
4512   $options->{payment_gateway} = $self->agent->payment_gateway( %$options )
4513     unless exists($options->{payment_gateway});
4514
4515   $options->{payment_gateway};
4516 }
4517
4518 sub _bop_auth {
4519   my ($self, $options) = @_;
4520
4521   (
4522     'login'    => $options->{payment_gateway}->gateway_username,
4523     'password' => $options->{payment_gateway}->gateway_password,
4524   );
4525 }
4526
4527 sub _bop_options {
4528   my ($self, $options) = @_;
4529
4530   $options->{payment_gateway}->gatewaynum
4531     ? $options->{payment_gateway}->options
4532     : @{ $options->{payment_gateway}->get('options') };
4533
4534 }
4535
4536 sub _bop_defaults {
4537   my ($self, $options) = @_;
4538
4539   unless ( $options->{'description'} ) {
4540     if ( $conf->exists('business-onlinepayment-description') ) {
4541       my $dtempl = $conf->config('business-onlinepayment-description');
4542
4543       my $agent = $self->agent->agent;
4544       #$pkgs... not here
4545       $options->{'description'} = eval qq("$dtempl");
4546     } else {
4547       $options->{'description'} = 'Internet services';
4548     }
4549   }
4550
4551   $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} );
4552   $options->{invnum} ||= '';
4553   $options->{payname} = $self->payname unless exists( $options->{payname} );
4554 }
4555
4556 sub _bop_content {
4557   my ($self, $options) = @_;
4558   my %content = ();
4559
4560   my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip;
4561   $content{customer_ip} = $payip if length($payip);
4562
4563   $content{invoice_number} = $options->{'invnum'}
4564     if exists($options->{'invnum'}) && length($options->{'invnum'});
4565
4566   $content{email_customer} =
4567     (    $conf->exists('business-onlinepayment-email_customer')
4568       || $conf->exists('business-onlinepayment-email-override') );
4569
4570   my ($payname, $payfirst, $paylast);
4571   if ( $options->{payname} && $options->{method} ne 'ECHECK' ) {
4572     ($payname = $options->{payname}) =~
4573       /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
4574       or return "Illegal payname $payname";
4575     ($payfirst, $paylast) = ($1, $2);
4576   } else {
4577     $payfirst = $self->getfield('first');
4578     $paylast = $self->getfield('last');
4579     $payname = "$payfirst $paylast";
4580   }
4581
4582   $content{last_name} = $paylast;
4583   $content{first_name} = $payfirst;
4584
4585   $content{name} = $payname;
4586
4587   $content{address} = exists($options->{'address1'})
4588                         ? $options->{'address1'}
4589                         : $self->address1;
4590   my $address2 = exists($options->{'address2'})
4591                    ? $options->{'address2'}
4592                    : $self->address2;
4593   $content{address} .= ", ". $address2 if length($address2);
4594
4595   $content{city} = exists($options->{city})
4596                      ? $options->{city}
4597                      : $self->city;
4598   $content{state} = exists($options->{state})
4599                       ? $options->{state}
4600                       : $self->state;
4601   $content{zip} = exists($options->{zip})
4602                     ? $options->{'zip'}
4603                     : $self->zip;
4604   $content{country} = exists($options->{country})
4605                         ? $options->{country}
4606                         : $self->country;
4607
4608   $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/
4609   $content{phone} = $self->daytime || $self->night;
4610
4611   \%content;
4612 }
4613
4614 my %bop_method2payby = (
4615   'CC'     => 'CARD',
4616   'ECHECK' => 'CHEK',
4617   'LEC'    => 'LECB',
4618 );
4619
4620 sub realtime_bop {
4621   my $self = shift;
4622
4623   my %options = ();
4624   if (ref($_[0]) eq 'HASH') {
4625     %options = %{$_[0]};
4626   } else {
4627     my ( $method, $amount ) = ( shift, shift );
4628     %options = @_;
4629     $options{method} = $method;
4630     $options{amount} = $amount;
4631   }
4632
4633   if ( $DEBUG ) {
4634     warn "$me realtime_bop (new): $options{method} $options{amount}\n";
4635     warn "  $_ => $options{$_}\n" foreach keys %options;
4636   }
4637
4638   return $self->fake_bop(%options) if $options{'fake'};
4639
4640   $self->_bop_defaults(\%options);
4641
4642   ###
4643   # set trans_is_recur based on invnum if there is one
4644   ###
4645
4646   my $trans_is_recur = 0;
4647   if ( $options{'invnum'} ) {
4648
4649     my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } );
4650     die "invnum ". $options{'invnum'}. " not found" unless $cust_bill;
4651
4652     my @part_pkg =
4653       map  { $_->part_pkg }
4654       grep { $_ }
4655       map  { $_->cust_pkg }
4656       $cust_bill->cust_bill_pkg;
4657
4658     $trans_is_recur = 1
4659       if grep { $_->freq ne '0' } @part_pkg;
4660
4661   }
4662
4663   ###
4664   # select a gateway
4665   ###
4666
4667   my $payment_gateway =  $self->_payment_gateway( \%options );
4668   my $namespace = $payment_gateway->gateway_namespace;
4669
4670   eval "use $namespace";
4671   die $@ if $@;
4672
4673   ###
4674   # check for banned credit card/ACH
4675   ###
4676
4677   my $ban = qsearchs('banned_pay', {
4678     'payby'   => $bop_method2payby{$options{method}},
4679     'payinfo' => md5_base64($options{payinfo}),
4680   } );
4681   return "Banned credit card" if $ban;
4682
4683   ###
4684   # massage data
4685   ###
4686
4687   my $bop_content = $self->_bop_content(\%options);
4688   return $bop_content unless ref($bop_content);
4689
4690   my @invoicing_list = $self->invoicing_list_emailonly;
4691   if ( $conf->exists('emailinvoiceautoalways')
4692        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
4693        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
4694     push @invoicing_list, $self->all_emails;
4695   }
4696
4697   my $email = ($conf->exists('business-onlinepayment-email-override'))
4698               ? $conf->config('business-onlinepayment-email-override')
4699               : $invoicing_list[0];
4700
4701   my $paydate = '';
4702   my %content = ();
4703   if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) {
4704
4705     $content{card_number} = $options{payinfo};
4706     $paydate = exists($options{'paydate'})
4707                     ? $options{'paydate'}
4708                     : $self->paydate;
4709     $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
4710     $content{expiration} = "$2/$1";
4711
4712     my $paycvv = exists($options{'paycvv'})
4713                    ? $options{'paycvv'}
4714                    : $self->paycvv;
4715     $content{cvv2} = $paycvv
4716       if length($paycvv);
4717
4718     my $paystart_month = exists($options{'paystart_month'})
4719                            ? $options{'paystart_month'}
4720                            : $self->paystart_month;
4721
4722     my $paystart_year  = exists($options{'paystart_year'})
4723                            ? $options{'paystart_year'}
4724                            : $self->paystart_year;
4725
4726     $content{card_start} = "$paystart_month/$paystart_year"
4727       if $paystart_month && $paystart_year;
4728
4729     my $payissue       = exists($options{'payissue'})
4730                            ? $options{'payissue'}
4731                            : $self->payissue;
4732     $content{issue_number} = $payissue if $payissue;
4733
4734     if ( $self->_bop_recurring_billing( 'payinfo'        => $options{'payinfo'},
4735                                         'trans_is_recur' => $trans_is_recur,
4736                                       )
4737        )
4738     {
4739       $content{recurring_billing} = 'YES';
4740       $content{acct_code} = 'rebill'
4741         if $conf->exists('credit_card-recurring_billing_acct_code');
4742     }
4743
4744   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){
4745     ( $content{account_number}, $content{routing_code} ) =
4746       split('@', $options{payinfo});
4747     $content{bank_name} = $options{payname};
4748     $content{bank_state} = exists($options{'paystate'})
4749                              ? $options{'paystate'}
4750                              : $self->getfield('paystate');
4751     $content{account_type} = exists($options{'paytype'})
4752                                ? uc($options{'paytype'}) || 'CHECKING'
4753                                : uc($self->getfield('paytype')) || 'CHECKING';
4754     $content{account_name} = $self->getfield('first'). ' '.
4755                              $self->getfield('last');
4756
4757     $content{customer_org} = $self->company ? 'B' : 'I';
4758     $content{state_id}       = exists($options{'stateid'})
4759                                  ? $options{'stateid'}
4760                                  : $self->getfield('stateid');
4761     $content{state_id_state} = exists($options{'stateid_state'})
4762                                  ? $options{'stateid_state'}
4763                                  : $self->getfield('stateid_state');
4764     $content{customer_ssn} = exists($options{'ss'})
4765                                ? $options{'ss'}
4766                                : $self->ss;
4767   } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) {
4768     $content{phone} = $options{payinfo};
4769   } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4770     #move along
4771   } else {
4772     #die an evil death
4773   }
4774
4775   ###
4776   # run transaction(s)
4777   ###
4778
4779   my $balance = exists( $options{'balance'} )
4780                   ? $options{'balance'}
4781                   : $self->balance;
4782
4783   $self->select_for_update; #mutex ... just until we get our pending record in
4784
4785   #the checks here are intended to catch concurrent payments
4786   #double-form-submission prevention is taken care of in cust_pay_pending::check
4787
4788   #check the balance
4789   return "The customer's balance has changed; $options{method} transaction aborted."
4790     if $self->balance < $balance;
4791     #&& $self->balance < $options{amount}; #might as well anyway?
4792
4793   #also check and make sure there aren't *other* pending payments for this cust
4794
4795   my @pending = qsearch('cust_pay_pending', {
4796     'custnum' => $self->custnum,
4797     'status'  => { op=>'!=', value=>'done' }
4798   });
4799   return "A payment is already being processed for this customer (".
4800          join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ).
4801          "); $options{method} transaction aborted."
4802     if scalar(@pending);
4803
4804   #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out
4805
4806   my $cust_pay_pending = new FS::cust_pay_pending {
4807     'custnum'           => $self->custnum,
4808     #'invnum'            => $options{'invnum'},
4809     'paid'              => $options{amount},
4810     '_date'             => '',
4811     'payby'             => $bop_method2payby{$options{method}},
4812     'payinfo'           => $options{payinfo},
4813     'paydate'           => $paydate,
4814     'recurring_billing' => $content{recurring_billing},
4815     'pkgnum'            => $options{'pkgnum'},
4816     'status'            => 'new',
4817     'gatewaynum'        => $payment_gateway->gatewaynum || '',
4818     'session_id'        => $options{session_id} || '',
4819     'jobnum'            => $options{depend_jobnum} || '',
4820   };
4821   $cust_pay_pending->payunique( $options{payunique} )
4822     if defined($options{payunique}) && length($options{payunique});
4823   my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted
4824   return $cpp_new_err if $cpp_new_err;
4825
4826   my( $action1, $action2 ) =
4827     split( /\s*\,\s*/, $payment_gateway->gateway_action );
4828
4829   my $transaction = new $namespace( $payment_gateway->gateway_module,
4830                                     $self->_bop_options(\%options),
4831                                   );
4832
4833   $transaction->content(
4834     'type'           => $options{method},
4835     $self->_bop_auth(\%options),
4836     'action'         => $action1,
4837     'description'    => $options{'description'},
4838     'amount'         => $options{amount},
4839     #'invoice_number' => $options{'invnum'},
4840     'customer_id'    => $self->custnum,
4841     %$bop_content,
4842     'reference'      => $cust_pay_pending->paypendingnum, #for now
4843     'email'          => $email,
4844     %content, #after
4845   );
4846
4847   $cust_pay_pending->status('pending');
4848   my $cpp_pending_err = $cust_pay_pending->replace;
4849   return $cpp_pending_err if $cpp_pending_err;
4850
4851   #config?
4852   my $BOP_TESTING = 0;
4853   my $BOP_TESTING_SUCCESS = 1;
4854
4855   unless ( $BOP_TESTING ) {
4856     $transaction->test_transaction(1)
4857       if $conf->exists('business-onlinepayment-test_transaction');
4858     $transaction->submit();
4859   } else {
4860     if ( $BOP_TESTING_SUCCESS ) {
4861       $transaction->is_success(1);
4862       $transaction->authorization('fake auth');
4863     } else {
4864       $transaction->is_success(0);
4865       $transaction->error_message('fake failure');
4866     }
4867   }
4868
4869   if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) {
4870
4871     return { reference => $cust_pay_pending->paypendingnum,
4872              map { $_ => $transaction->$_ } qw ( popup_url collectitems ) };
4873
4874   } elsif ( $transaction->is_success() && $action2 ) {
4875
4876     $cust_pay_pending->status('authorized');
4877     my $cpp_authorized_err = $cust_pay_pending->replace;
4878     return $cpp_authorized_err if $cpp_authorized_err;
4879
4880     my $auth = $transaction->authorization;
4881     my $ordernum = $transaction->can('order_number')
4882                    ? $transaction->order_number
4883                    : '';
4884
4885     my $capture =
4886       new Business::OnlinePayment( $payment_gateway->gateway_module,
4887                                    $self->_bop_options(\%options),
4888                                  );
4889
4890     my %capture = (
4891       %content,
4892       type           => $options{method},
4893       action         => $action2,
4894       $self->_bop_auth(\%options),
4895       order_number   => $ordernum,
4896       amount         => $options{amount},
4897       authorization  => $auth,
4898       description    => $options{'description'},
4899     );
4900
4901     foreach my $field (qw( authorization_source_code returned_ACI
4902                            transaction_identifier validation_code
4903                            transaction_sequence_num local_transaction_date
4904                            local_transaction_time AVS_result_code          )) {
4905       $capture{$field} = $transaction->$field() if $transaction->can($field);
4906     }
4907
4908     $capture->content( %capture );
4909
4910     $capture->test_transaction(1)
4911       if $conf->exists('business-onlinepayment-test_transaction');
4912     $capture->submit();
4913
4914     unless ( $capture->is_success ) {
4915       my $e = "Authorization successful but capture failed, custnum #".
4916               $self->custnum. ': '.  $capture->result_code.
4917               ": ". $capture->error_message;
4918       warn $e;
4919       return $e;
4920     }
4921
4922   }
4923
4924   ###
4925   # remove paycvv after initial transaction
4926   ###
4927
4928   #false laziness w/misc/process/payment.cgi - check both to make sure working
4929   # correctly
4930   if ( defined $self->dbdef_table->column('paycvv')
4931        && length($self->paycvv)
4932        && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save')
4933   ) {
4934     my $error = $self->remove_cvv;
4935     if ( $error ) {
4936       warn "WARNING: error removing cvv: $error\n";
4937     }
4938   }
4939
4940   ###
4941   # Tokenize
4942   ###
4943
4944
4945   if ( $transaction->can('card_token') && $transaction->card_token ) {
4946
4947     $self->card_token($transaction->card_token);
4948
4949     if ( $options{'payinfo'} eq $self->payinfo ) {
4950       $self->payinfo($transaction->card_token);
4951       my $error = $self->replace;
4952       if ( $error ) {
4953         warn "WARNING: error storing token: $error, but proceeding anyway\n";
4954       }
4955     }
4956
4957   }
4958
4959   ###
4960   # result handling
4961   ###
4962
4963   $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
4964
4965 }
4966
4967 =item fake_bop
4968
4969 =cut
4970
4971 sub fake_bop {
4972   my $self = shift;
4973
4974   my %options = ();
4975   if (ref($_[0]) eq 'HASH') {
4976     %options = %{$_[0]};
4977   } else {
4978     my ( $method, $amount ) = ( shift, shift );
4979     %options = @_;
4980     $options{method} = $method;
4981     $options{amount} = $amount;
4982   }
4983
4984   if ( $options{'fake_failure'} ) {
4985      return "Error: No error; test failure requested with fake_failure";
4986   }
4987
4988   #my $paybatch = '';
4989   #if ( $payment_gateway->gatewaynum ) { # agent override
4990   #  $paybatch = $payment_gateway->gatewaynum. '-';
4991   #}
4992   #
4993   #$paybatch .= "$processor:". $transaction->authorization;
4994   #
4995   #$paybatch .= ':'. $transaction->order_number
4996   #  if $transaction->can('order_number')
4997   #  && length($transaction->order_number);
4998
4999   my $paybatch = 'FakeProcessor:54:32';
5000
5001   my $cust_pay = new FS::cust_pay ( {
5002      'custnum'  => $self->custnum,
5003      'invnum'   => $options{'invnum'},
5004      'paid'     => $options{amount},
5005      '_date'    => '',
5006      'payby'    => $bop_method2payby{$options{method}},
5007      #'payinfo'  => $payinfo,
5008      'payinfo'  => '4111111111111111',
5009      'paybatch' => $paybatch,
5010      #'paydate'  => $paydate,
5011      'paydate'  => '2012-05-01',
5012   } );
5013   $cust_pay->payunique( $options{payunique} ) if length($options{payunique});
5014
5015   my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5016
5017   if ( $error ) {
5018     $cust_pay->invnum(''); #try again with no specific invnum
5019     my $error2 = $cust_pay->insert( $options{'manual'} ?
5020                                     ( 'manual' => 1 ) : ()
5021                                   );
5022     if ( $error2 ) {
5023       # gah, even with transactions.
5024       my $e = 'WARNING: Card/ACH debited but database not updated - '.
5025               "error inserting (fake!) payment: $error2".
5026               " (previously tried insert with invnum #$options{'invnum'}" .
5027               ": $error )";
5028       warn $e;
5029       return $e;
5030     }
5031   }
5032
5033   if ( $options{'paynum_ref'} ) {
5034     ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5035   }
5036
5037   return ''; #no error
5038
5039 }
5040
5041
5042 # item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ]
5043 #
5044 # Wraps up processing of a realtime credit card, ACH (electronic check) or
5045 # phone bill transaction.
5046
5047 sub _realtime_bop_result {
5048   my( $self, $cust_pay_pending, $transaction, %options ) = @_;
5049   if ( $DEBUG ) {
5050     warn "$me _realtime_bop_result: pending transaction ".
5051       $cust_pay_pending->paypendingnum. "\n";
5052     warn "  $_ => $options{$_}\n" foreach keys %options;
5053   }
5054
5055   my $payment_gateway = $options{payment_gateway}
5056     or return "no payment gateway in arguments to _realtime_bop_result";
5057
5058   $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined');
5059   my $cpp_captured_err = $cust_pay_pending->replace;
5060   return $cpp_captured_err if $cpp_captured_err;
5061
5062   if ( $transaction->is_success() ) {
5063
5064     my $paybatch = '';
5065     if ( $payment_gateway->gatewaynum ) { # agent override
5066       $paybatch = $payment_gateway->gatewaynum. '-';
5067     }
5068
5069     $paybatch .= $payment_gateway->gateway_module. ":".
5070       $transaction->authorization;
5071
5072     $paybatch .= ':'. $transaction->order_number
5073       if $transaction->can('order_number')
5074       && length($transaction->order_number);
5075
5076     my $cust_pay = new FS::cust_pay ( {
5077        'custnum'  => $self->custnum,
5078        'invnum'   => $options{'invnum'},
5079        'paid'     => $cust_pay_pending->paid,
5080        '_date'    => '',
5081        'payby'    => $cust_pay_pending->payby,
5082        'payinfo'  => $options{'payinfo'},
5083        'paybatch' => $paybatch,
5084        'paydate'  => $cust_pay_pending->paydate,
5085        'pkgnum'   => $cust_pay_pending->pkgnum,
5086     } );
5087     #doesn't hurt to know, even though the dup check is in cust_pay_pending now
5088     $cust_pay->payunique( $options{payunique} )
5089       if defined($options{payunique}) && length($options{payunique});
5090
5091     my $oldAutoCommit = $FS::UID::AutoCommit;
5092     local $FS::UID::AutoCommit = 0;
5093     my $dbh = dbh;
5094
5095     #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction
5096
5097     my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () );
5098
5099     if ( $error ) {
5100       $cust_pay->invnum(''); #try again with no specific invnum
5101       my $error2 = $cust_pay->insert( $options{'manual'} ?
5102                                       ( 'manual' => 1 ) : ()
5103                                     );
5104       if ( $error2 ) {
5105         # gah.  but at least we have a record of the state we had to abort in
5106         # from cust_pay_pending now.
5107         my $e = "WARNING: $options{method} captured but payment not recorded -".
5108                 " error inserting payment (". $payment_gateway->gateway_module.
5109                 "): $error2".
5110                 " (previously tried insert with invnum #$options{'invnum'}" .
5111                 ": $error ) - pending payment saved as paypendingnum ".
5112                 $cust_pay_pending->paypendingnum. "\n";
5113         warn $e;
5114         return $e;
5115       }
5116     }
5117
5118     my $jobnum = $cust_pay_pending->jobnum;
5119     if ( $jobnum ) {
5120        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5121
5122        unless ( $placeholder ) {
5123          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5124          my $e = "WARNING: $options{method} captured but job $jobnum not ".
5125              "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n";
5126          warn $e;
5127          return $e;
5128        }
5129
5130        $error = $placeholder->delete;
5131
5132        if ( $error ) {
5133          $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5134          my $e = "WARNING: $options{method} captured but could not delete ".
5135               "job $jobnum for paypendingnum ".
5136               $cust_pay_pending->paypendingnum. ": $error\n";
5137          warn $e;
5138          return $e;
5139        }
5140
5141     }
5142
5143     if ( $options{'paynum_ref'} ) {
5144       ${ $options{'paynum_ref'} } = $cust_pay->paynum;
5145     }
5146
5147     $cust_pay_pending->status('done');
5148     $cust_pay_pending->statustext('captured');
5149     $cust_pay_pending->paynum($cust_pay->paynum);
5150     my $cpp_done_err = $cust_pay_pending->replace;
5151
5152     if ( $cpp_done_err ) {
5153
5154       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
5155       my $e = "WARNING: $options{method} captured but payment not recorded - ".
5156               "error updating status for paypendingnum ".
5157               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5158       warn $e;
5159       return $e;
5160
5161     } else {
5162
5163       $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5164
5165       if ( $options{'apply'} ) {
5166         my $apply_error = $self->apply_payments_and_credits;
5167         if ( $apply_error ) {
5168           warn "WARNING: error applying payment: $apply_error\n";
5169           #but we still should return no error cause the payment otherwise went
5170           #through...
5171         }
5172       }
5173
5174       return ''; #no error
5175
5176     }
5177
5178   } else {
5179
5180     my $perror = $payment_gateway->gateway_module. " error: ".
5181       $transaction->error_message;
5182
5183     my $jobnum = $cust_pay_pending->jobnum;
5184     if ( $jobnum ) {
5185        my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } );
5186
5187        if ( $placeholder ) {
5188          my $error = $placeholder->depended_delete;
5189          $error ||= $placeholder->delete;
5190          warn "error removing provisioning jobs after declined paypendingnum ".
5191            $cust_pay_pending->paypendingnum. "\n";
5192        } else {
5193          my $e = "error finding job $jobnum for declined paypendingnum ".
5194               $cust_pay_pending->paypendingnum. "\n";
5195          warn $e;
5196        }
5197
5198     }
5199
5200     unless ( $transaction->error_message ) {
5201
5202       my $t_response;
5203       if ( $transaction->can('response_page') ) {
5204         $t_response = {
5205                         'page'    => ( $transaction->can('response_page')
5206                                          ? $transaction->response_page
5207                                          : ''
5208                                      ),
5209                         'code'    => ( $transaction->can('response_code')
5210                                          ? $transaction->response_code
5211                                          : ''
5212                                      ),
5213                         'headers' => ( $transaction->can('response_headers')
5214                                          ? $transaction->response_headers
5215                                          : ''
5216                                      ),
5217                       };
5218       } else {
5219         $t_response .=
5220           "No additional debugging information available for ".
5221             $payment_gateway->gateway_module;
5222       }
5223
5224       $perror .= "No error_message returned from ".
5225                    $payment_gateway->gateway_module. " -- ".
5226                  ( ref($t_response) ? Dumper($t_response) : $t_response );
5227
5228     }
5229
5230     if ( !$options{'quiet'} && !$realtime_bop_decline_quiet
5231          && $conf->exists('emaildecline')
5232          && grep { $_ ne 'POST' } $self->invoicing_list
5233          && ! grep { $transaction->error_message =~ /$_/ }
5234                    $conf->config('emaildecline-exclude')
5235     ) {
5236
5237       # Send a decline alert to the customer.
5238       my $msgnum = $conf->config('decline_msgnum', $self->agentnum);
5239       my $error = '';
5240       if ( $msgnum ) {
5241         # include the raw error message in the transaction state
5242         $cust_pay_pending->setfield('error', $transaction->error_message);
5243         my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
5244         $error = $msg_template->send( 'cust_main' => $self,
5245                                       'object'    => $cust_pay_pending );
5246       }
5247       else { #!$msgnum
5248
5249         my @templ = $conf->config('declinetemplate');
5250         my $template = new Text::Template (
5251           TYPE   => 'ARRAY',
5252           SOURCE => [ map "$_\n", @templ ],
5253         ) or return "($perror) can't create template: $Text::Template::ERROR";
5254         $template->compile()
5255           or return "($perror) can't compile template: $Text::Template::ERROR";
5256
5257         my $templ_hash = {
5258           'company_name'    =>
5259             scalar( $conf->config('company_name', $self->agentnum ) ),
5260           'company_address' =>
5261             join("\n", $conf->config('company_address', $self->agentnum ) ),
5262           'error'           => $transaction->error_message,
5263         };
5264
5265         my $error = send_email(
5266           'from'    => $conf->config('invoice_from', $self->agentnum ),
5267           'to'      => [ grep { $_ ne 'POST' } $self->invoicing_list ],
5268           'subject' => 'Your payment could not be processed',
5269           'body'    => [ $template->fill_in(HASH => $templ_hash) ],
5270         );
5271       }
5272
5273       $perror .= " (also received error sending decline notification: $error)"
5274         if $error;
5275
5276     }
5277
5278     $cust_pay_pending->status('done');
5279     $cust_pay_pending->statustext("declined: $perror");
5280     my $cpp_done_err = $cust_pay_pending->replace;
5281     if ( $cpp_done_err ) {
5282       my $e = "WARNING: $options{method} declined but pending payment not ".
5283               "resolved - error updating status for paypendingnum ".
5284               $cust_pay_pending->paypendingnum. ": $cpp_done_err \n";
5285       warn $e;
5286       $perror = "$e ($perror)";
5287     }
5288
5289     return $perror;
5290   }
5291
5292 }
5293
5294 =item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ]
5295
5296 Verifies successful third party processing of a realtime credit card,
5297 ACH (electronic check) or phone bill transaction via a
5298 Business::OnlineThirdPartyPayment realtime gateway.  See
5299 L<http://420.am/business-onlinethirdpartypayment> for supported gateways.
5300
5301 Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>
5302
5303 The additional options I<payname>, I<city>, I<state>,
5304 I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5305 if set, will override the value from the customer record.
5306
5307 I<description> is a free-text field passed to the gateway.  It defaults to
5308 "Internet services".
5309
5310 If an I<invnum> is specified, this payment (if successful) is applied to the
5311 specified invoice.  If you don't specify an I<invnum> you might want to
5312 call the B<apply_payments> method.
5313
5314 I<quiet> can be set true to surpress email decline notices.
5315
5316 I<paynum_ref> can be set to a scalar reference.  It will be filled in with the
5317 resulting paynum, if any.
5318
5319 I<payunique> is a unique identifier for this payment.
5320
5321 Returns a hashref containing elements bill_error (which will be undefined
5322 upon success) and session_id of any associated session.
5323
5324 =cut
5325
5326 sub realtime_botpp_capture {
5327   my( $self, $cust_pay_pending, %options ) = @_;
5328   if ( $DEBUG ) {
5329     warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n";
5330     warn "  $_ => $options{$_}\n" foreach keys %options;
5331   }
5332
5333   eval "use Business::OnlineThirdPartyPayment";
5334   die $@ if $@;
5335
5336   ###
5337   # select the gateway
5338   ###
5339
5340   my $method = FS::payby->payby2bop($cust_pay_pending->payby);
5341
5342   my $payment_gateway = $cust_pay_pending->gatewaynum
5343     ? qsearchs( 'payment_gateway',
5344                 { gatewaynum => $cust_pay_pending->gatewaynum }
5345               )
5346     : $self->agent->payment_gateway( 'method' => $method,
5347                                      # 'invnum'  => $cust_pay_pending->invnum,
5348                                      # 'payinfo' => $cust_pay_pending->payinfo,
5349                                    );
5350
5351   $options{payment_gateway} = $payment_gateway; # for the helper subs
5352
5353   ###
5354   # massage data
5355   ###
5356
5357   my @invoicing_list = $self->invoicing_list_emailonly;
5358   if ( $conf->exists('emailinvoiceautoalways')
5359        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5360        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5361     push @invoicing_list, $self->all_emails;
5362   }
5363
5364   my $email = ($conf->exists('business-onlinepayment-email-override'))
5365               ? $conf->config('business-onlinepayment-email-override')
5366               : $invoicing_list[0];
5367
5368   my %content = ();
5369
5370   $content{email_customer} =
5371     (    $conf->exists('business-onlinepayment-email_customer')
5372       || $conf->exists('business-onlinepayment-email-override') );
5373
5374   ###
5375   # run transaction(s)
5376   ###
5377
5378   my $transaction =
5379     new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module,
5380                                            $self->_bop_options(\%options),
5381                                          );
5382
5383   $transaction->reference({ %options });
5384
5385   $transaction->content(
5386     'type'           => $method,
5387     $self->_bop_auth(\%options),
5388     'action'         => 'Post Authorization',
5389     'description'    => $options{'description'},
5390     'amount'         => $cust_pay_pending->paid,
5391     #'invoice_number' => $options{'invnum'},
5392     'customer_id'    => $self->custnum,
5393     'referer'        => 'http://cleanwhisker.420.am/',
5394     'reference'      => $cust_pay_pending->paypendingnum,
5395     'email'          => $email,
5396     'phone'          => $self->daytime || $self->night,
5397     %content, #after
5398     # plus whatever is required for bogus capture avoidance
5399   );
5400
5401   $transaction->submit();
5402
5403   my $error =
5404     $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options );
5405
5406   {
5407     bill_error => $error,
5408     session_id => $cust_pay_pending->session_id,
5409   }
5410
5411 }
5412
5413 =item default_payment_gateway DEPRECATED -- use agent->payment_gateway
5414
5415 =cut
5416
5417 sub default_payment_gateway {
5418   my( $self, $method ) = @_;
5419
5420   die "Real-time processing not enabled\n"
5421     unless $conf->exists('business-onlinepayment');
5422
5423   #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n";
5424
5425   #load up config
5426   my $bop_config = 'business-onlinepayment';
5427   $bop_config .= '-ach'
5428     if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach');
5429   my ( $processor, $login, $password, $action, @bop_options ) =
5430     $conf->config($bop_config);
5431   $action ||= 'normal authorization';
5432   pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/;
5433   die "No real-time processor is enabled - ".
5434       "did you set the business-onlinepayment configuration value?\n"
5435     unless $processor;
5436
5437   ( $processor, $login, $password, $action, @bop_options )
5438 }
5439
5440 =item remove_cvv
5441
5442 Removes the I<paycvv> field from the database directly.
5443
5444 If there is an error, returns the error, otherwise returns false.
5445
5446 =cut
5447
5448 sub remove_cvv {
5449   my $self = shift;
5450   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
5451     or return dbh->errstr;
5452   $sth->execute($self->custnum)
5453     or return $sth->errstr;
5454   $self->paycvv('');
5455   '';
5456 }
5457
5458 =item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
5459
5460 Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
5461 via a Business::OnlinePayment realtime gateway.  See
5462 L<http://420.am/business-onlinepayment> for supported gateways.
5463
5464 Available methods are: I<CC>, I<ECHECK> and I<LEC>
5465
5466 Available options are: I<amount>, I<reason>, I<paynum>, I<paydate>
5467
5468 Most gateways require a reference to an original payment transaction to refund,
5469 so you probably need to specify a I<paynum>.
5470
5471 I<amount> defaults to the original amount of the payment if not specified.
5472
5473 I<reason> specifies a reason for the refund.
5474
5475 I<paydate> specifies the expiration date for a credit card overriding the
5476 value from the customer record or the payment record. Specified as yyyy-mm-dd
5477
5478 Implementation note: If I<amount> is unspecified or equal to the amount of the
5479 orignal payment, first an attempt is made to "void" the transaction via
5480 the gateway (to cancel a not-yet settled transaction) and then if that fails,
5481 the normal attempt is made to "refund" ("credit") the transaction via the
5482 gateway is attempted.
5483
5484 #The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>,
5485 #I<zip>, I<payinfo> and I<paydate> are also available.  Any of these options,
5486 #if set, will override the value from the customer record.
5487
5488 #If an I<invnum> is specified, this payment (if successful) is applied to the
5489 #specified invoice.  If you don't specify an I<invnum> you might want to
5490 #call the B<apply_payments> method.
5491
5492 =cut
5493
5494 #some false laziness w/realtime_bop, not enough to make it worth merging
5495 #but some useful small subs should be pulled out
5496 sub realtime_refund_bop {
5497   my $self = shift;
5498
5499   my %options = ();
5500   if (ref($_[0]) eq 'HASH') {
5501     %options = %{$_[0]};
5502   } else {
5503     my $method = shift;
5504     %options = @_;
5505     $options{method} = $method;
5506   }
5507
5508   if ( $DEBUG ) {
5509     warn "$me realtime_refund_bop (new): $options{method} refund\n";
5510     warn "  $_ => $options{$_}\n" foreach keys %options;
5511   }
5512
5513   ###
5514   # look up the original payment and optionally a gateway for that payment
5515   ###
5516
5517   my $cust_pay = '';
5518   my $amount = $options{'amount'};
5519
5520   my( $processor, $login, $password, @bop_options, $namespace ) ;
5521   my( $auth, $order_number ) = ( '', '', '' );
5522
5523   if ( $options{'paynum'} ) {
5524
5525     warn "  paynum: $options{paynum}\n" if $DEBUG > 1;
5526     $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } )
5527       or return "Unknown paynum $options{'paynum'}";
5528     $amount ||= $cust_pay->paid;
5529
5530     $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/
5531       or return "Can't parse paybatch for paynum $options{'paynum'}: ".
5532                 $cust_pay->paybatch;
5533     my $gatewaynum = '';
5534     ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 );
5535
5536     if ( $gatewaynum ) { #gateway for the payment to be refunded
5537
5538       my $payment_gateway =
5539         qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } );
5540       die "payment gateway $gatewaynum not found"
5541         unless $payment_gateway;
5542
5543       $processor   = $payment_gateway->gateway_module;
5544       $login       = $payment_gateway->gateway_username;
5545       $password    = $payment_gateway->gateway_password;
5546       $namespace   = $payment_gateway->gateway_namespace;
5547       @bop_options = $payment_gateway->options;
5548
5549     } else { #try the default gateway
5550
5551       my $conf_processor;
5552       my $payment_gateway =
5553         $self->agent->payment_gateway('method' => $options{method});
5554
5555       ( $conf_processor, $login, $password, $namespace ) =
5556         map { my $method = "gateway_$_"; $payment_gateway->$method }
5557           qw( module username password namespace );
5558
5559       @bop_options = $payment_gateway->gatewaynum
5560                        ? $payment_gateway->options
5561                        : @{ $payment_gateway->get('options') };
5562
5563       return "processor of payment $options{'paynum'} $processor does not".
5564              " match default processor $conf_processor"
5565         unless $processor eq $conf_processor;
5566
5567     }
5568
5569
5570   } else { # didn't specify a paynum, so look for agent gateway overrides
5571            # like a normal transaction
5572
5573     my $payment_gateway =
5574       $self->agent->payment_gateway( 'method'  => $options{method},
5575                                      #'payinfo' => $payinfo,
5576                                    );
5577     my( $processor, $login, $password, $namespace ) =
5578       map { my $method = "gateway_$_"; $payment_gateway->$method }
5579         qw( module username password namespace );
5580
5581     my @bop_options = $payment_gateway->gatewaynum
5582                         ? $payment_gateway->options
5583                         : @{ $payment_gateway->get('options') };
5584
5585   }
5586   return "neither amount nor paynum specified" unless $amount;
5587
5588   eval "use $namespace";
5589   die $@ if $@;
5590
5591   my %content = (
5592     'type'           => $options{method},
5593     'login'          => $login,
5594     'password'       => $password,
5595     'order_number'   => $order_number,
5596     'amount'         => $amount,
5597     'referer'        => 'http://cleanwhisker.420.am/', #XXX fix referer :/
5598   );
5599   $content{authorization} = $auth
5600     if length($auth); #echeck/ACH transactions have an order # but no auth
5601                       #(at least with authorize.net)
5602
5603   my $disable_void_after;
5604   if ($conf->exists('disable_void_after')
5605       && $conf->config('disable_void_after') =~ /^(\d+)$/) {
5606     $disable_void_after = $1;
5607   }
5608
5609   #first try void if applicable
5610   if ( $cust_pay && $cust_pay->paid == $amount
5611     && (
5612       ( not defined($disable_void_after) )
5613       || ( time < ($cust_pay->_date + $disable_void_after ) )
5614     )
5615   ) {
5616     warn "  attempting void\n" if $DEBUG > 1;
5617     my $void = new Business::OnlinePayment( $processor, @bop_options );
5618     if ( $void->can('info') ) {
5619       if ( $cust_pay->payby eq 'CARD'
5620            && $void->info('CC_void_requires_card') )
5621       {
5622         $content{'card_number'} = $cust_pay->payinfo;
5623       } elsif ( $cust_pay->payby eq 'CHEK'
5624                 && $void->info('ECHECK_void_requires_account') )
5625       {
5626         ( $content{'account_number'}, $content{'routing_code'} ) =
5627           split('@', $cust_pay->payinfo);
5628         $content{'name'} = $self->get('first'). ' '. $self->get('last');
5629       }
5630     }
5631     $void->content( 'action' => 'void', %content );
5632     $void->test_transaction(1)
5633       if $conf->exists('business-onlinepayment-test_transaction');
5634     $void->submit();
5635     if ( $void->is_success ) {
5636       my $error = $cust_pay->void($options{'reason'});
5637       if ( $error ) {
5638         # gah, even with transactions.
5639         my $e = 'WARNING: Card/ACH voided but database not updated - '.
5640                 "error voiding payment: $error";
5641         warn $e;
5642         return $e;
5643       }
5644       warn "  void successful\n" if $DEBUG > 1;
5645       return '';
5646     }
5647   }
5648
5649   warn "  void unsuccessful, trying refund\n"
5650     if $DEBUG > 1;
5651
5652   #massage data
5653   my $address = $self->address1;
5654   $address .= ", ". $self->address2 if $self->address2;
5655
5656   my($payname, $payfirst, $paylast);
5657   if ( $self->payname && $options{method} ne 'ECHECK' ) {
5658     $payname = $self->payname;
5659     $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
5660       or return "Illegal payname $payname";
5661     ($payfirst, $paylast) = ($1, $2);
5662   } else {
5663     $payfirst = $self->getfield('first');
5664     $paylast = $self->getfield('last');
5665     $payname =  "$payfirst $paylast";
5666   }
5667
5668   my @invoicing_list = $self->invoicing_list_emailonly;
5669   if ( $conf->exists('emailinvoiceautoalways')
5670        || $conf->exists('emailinvoiceauto') && ! @invoicing_list
5671        || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) {
5672     push @invoicing_list, $self->all_emails;
5673   }
5674
5675   my $email = ($conf->exists('business-onlinepayment-email-override'))
5676               ? $conf->config('business-onlinepayment-email-override')
5677               : $invoicing_list[0];
5678
5679   my $payip = exists($options{'payip'})
5680                 ? $options{'payip'}
5681                 : $self->payip;
5682   $content{customer_ip} = $payip
5683     if length($payip);
5684
5685   my $payinfo = '';
5686   if ( $options{method} eq 'CC' ) {
5687
5688     if ( $cust_pay ) {
5689       $content{card_number} = $payinfo = $cust_pay->payinfo;
5690       (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate)
5691         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ &&
5692         ($content{expiration} = "$2/$1");  # where available
5693     } else {
5694       $content{card_number} = $payinfo = $self->payinfo;
5695       (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate)
5696         =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
5697       $content{expiration} = "$2/$1";
5698     }
5699
5700   } elsif ( $options{method} eq 'ECHECK' ) {
5701
5702     if ( $cust_pay ) {
5703       $payinfo = $cust_pay->payinfo;
5704     } else {
5705       $payinfo = $self->payinfo;
5706     }
5707     ( $content{account_number}, $content{routing_code} )= split('@', $payinfo );
5708     $content{bank_name} = $self->payname;
5709     $content{account_type} = 'CHECKING';
5710     $content{account_name} = $payname;
5711     $content{customer_org} = $self->company ? 'B' : 'I';
5712     $content{customer_ssn} = $self->ss;
5713   } elsif ( $options{method} eq 'LEC' ) {
5714     $content{phone} = $payinfo = $self->payinfo;
5715   }
5716
5717   #then try refund
5718   my $refund = new Business::OnlinePayment( $processor, @bop_options );
5719   my %sub_content = $refund->content(
5720     'action'         => 'credit',
5721     'customer_id'    => $self->custnum,
5722     'last_name'      => $paylast,
5723     'first_name'     => $payfirst,
5724     'name'           => $payname,
5725     'address'        => $address,
5726     'city'           => $self->city,
5727     'state'          => $self->state,
5728     'zip'            => $self->zip,
5729     'country'        => $self->country,
5730     'email'          => $email,
5731     'phone'          => $self->daytime || $self->night,
5732     %content, #after
5733   );
5734   warn join('', map { "  $_ => $sub_content{$_}\n" } keys %sub_content )
5735     if $DEBUG > 1;
5736   $refund->test_transaction(1)
5737     if $conf->exists('business-onlinepayment-test_transaction');
5738   $refund->submit();
5739
5740   return "$processor error: ". $refund->error_message
5741     unless $refund->is_success();
5742
5743   my $paybatch = "$processor:". $refund->authorization;
5744   $paybatch .= ':'. $refund->order_number
5745     if $refund->can('order_number') && $refund->order_number;
5746
5747   while ( $cust_pay && $cust_pay->unapplied < $amount ) {
5748     my @cust_bill_pay = $cust_pay->cust_bill_pay;
5749     last unless @cust_bill_pay;
5750     my $cust_bill_pay = pop @cust_bill_pay;
5751     my $error = $cust_bill_pay->delete;
5752     last if $error;
5753   }
5754
5755   my $cust_refund = new FS::cust_refund ( {
5756     'custnum'  => $self->custnum,
5757     'paynum'   => $options{'paynum'},
5758     'refund'   => $amount,
5759     '_date'    => '',
5760     'payby'    => $bop_method2payby{$options{method}},
5761     'payinfo'  => $payinfo,
5762     'paybatch' => $paybatch,
5763     'reason'   => $options{'reason'} || 'card or ACH refund',
5764   } );
5765   my $error = $cust_refund->insert;
5766   if ( $error ) {
5767     $cust_refund->paynum(''); #try again with no specific paynum
5768     my $error2 = $cust_refund->insert;
5769     if ( $error2 ) {
5770       # gah, even with transactions.
5771       my $e = 'WARNING: Card/ACH refunded but database not updated - '.
5772               "error inserting refund ($processor): $error2".
5773               " (previously tried insert with paynum #$options{'paynum'}" .
5774               ": $error )";
5775       warn $e;
5776       return $e;
5777     }
5778   }
5779
5780   ''; #no error
5781
5782 }
5783
5784 =item batch_card OPTION => VALUE...
5785
5786 Adds a payment for this invoice to the pending credit card batch (see
5787 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
5788 runs the payment using a realtime gateway.
5789
5790 =cut
5791
5792 sub batch_card {
5793   my ($self, %options) = @_;
5794
5795   my $amount;
5796   if (exists($options{amount})) {
5797     $amount = $options{amount};
5798   }else{
5799     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
5800   }
5801   return '' unless $amount > 0;
5802
5803   my $invnum = delete $options{invnum};
5804   my $payby = $options{invnum} || $self->payby;  #dubious
5805
5806   if ($options{'realtime'}) {
5807     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
5808                                 $amount,
5809                                 %options,
5810                               );
5811   }
5812
5813   my $oldAutoCommit = $FS::UID::AutoCommit;
5814   local $FS::UID::AutoCommit = 0;
5815   my $dbh = dbh;
5816
5817   #this needs to handle mysql as well as Pg, like svc_acct.pm
5818   #(make it into a common function if folks need to do batching with mysql)
5819   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
5820     or return "Cannot lock pay_batch: " . $dbh->errstr;
5821
5822   my %pay_batch = (
5823     'status' => 'O',
5824     'payby'  => FS::payby->payby2payment($payby),
5825   );
5826
5827   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
5828
5829   unless ( $pay_batch ) {
5830     $pay_batch = new FS::pay_batch \%pay_batch;
5831     my $error = $pay_batch->insert;
5832     if ( $error ) {
5833       $dbh->rollback if $oldAutoCommit;
5834       die "error creating new batch: $error\n";
5835     }
5836   }
5837
5838   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
5839       'batchnum' => $pay_batch->batchnum,
5840       'custnum'  => $self->custnum,
5841   } );
5842
5843   foreach (qw( address1 address2 city state zip country payby payinfo paydate
5844                payname )) {
5845     $options{$_} = '' unless exists($options{$_});
5846   }
5847
5848   my $cust_pay_batch = new FS::cust_pay_batch ( {
5849     'batchnum' => $pay_batch->batchnum,
5850     'invnum'   => $invnum || 0,                    # is there a better value?
5851                                                    # this field should be
5852                                                    # removed...
5853                                                    # cust_bill_pay_batch now
5854     'custnum'  => $self->custnum,
5855     'last'     => $self->getfield('last'),
5856     'first'    => $self->getfield('first'),
5857     'address1' => $options{address1} || $self->address1,
5858     'address2' => $options{address2} || $self->address2,
5859     'city'     => $options{city}     || $self->city,
5860     'state'    => $options{state}    || $self->state,
5861     'zip'      => $options{zip}      || $self->zip,
5862     'country'  => $options{country}  || $self->country,
5863     'payby'    => $options{payby}    || $self->payby,
5864     'payinfo'  => $options{payinfo}  || $self->payinfo,
5865     'exp'      => $options{paydate}  || $self->paydate,
5866     'payname'  => $options{payname}  || $self->payname,
5867     'amount'   => $amount,                         # consolidating
5868   } );
5869
5870   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
5871     if $old_cust_pay_batch;
5872
5873   my $error;
5874   if ($old_cust_pay_batch) {
5875     $error = $cust_pay_batch->replace($old_cust_pay_batch)
5876   } else {
5877     $error = $cust_pay_batch->insert;
5878   }
5879
5880   if ( $error ) {
5881     $dbh->rollback if $oldAutoCommit;
5882     die $error;
5883   }
5884
5885   my $unapplied =   $self->total_unapplied_credits
5886                   + $self->total_unapplied_payments
5887                   + $self->in_transit_payments;
5888   foreach my $cust_bill ($self->open_cust_bill) {
5889     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
5890     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
5891       'invnum' => $cust_bill->invnum,
5892       'paybatchnum' => $cust_pay_batch->paybatchnum,
5893       'amount' => $cust_bill->owed,
5894       '_date' => time,
5895     };
5896     if ($unapplied >= $cust_bill_pay_batch->amount){
5897       $unapplied -= $cust_bill_pay_batch->amount;
5898       next;
5899     }else{
5900       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
5901                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
5902     }
5903     $error = $cust_bill_pay_batch->insert;
5904     if ( $error ) {
5905       $dbh->rollback if $oldAutoCommit;
5906       die $error;
5907     }
5908   }
5909
5910   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5911   '';
5912 }
5913
5914 =item apply_payments_and_credits [ OPTION => VALUE ... ]
5915
5916 Applies unapplied payments and credits.
5917
5918 In most cases, this new method should be used in place of sequential
5919 apply_payments and apply_credits methods.
5920
5921 A hash of optional arguments may be passed.  Currently "manual" is supported.
5922 If true, a payment receipt is sent instead of a statement when
5923 'payment_receipt_email' configuration option is set.
5924
5925 If there is an error, returns the error, otherwise returns false.
5926
5927 =cut
5928
5929 sub apply_payments_and_credits {
5930   my( $self, %options ) = @_;
5931
5932   local $SIG{HUP} = 'IGNORE';
5933   local $SIG{INT} = 'IGNORE';
5934   local $SIG{QUIT} = 'IGNORE';
5935   local $SIG{TERM} = 'IGNORE';
5936   local $SIG{TSTP} = 'IGNORE';
5937   local $SIG{PIPE} = 'IGNORE';
5938
5939   my $oldAutoCommit = $FS::UID::AutoCommit;
5940   local $FS::UID::AutoCommit = 0;
5941   my $dbh = dbh;
5942
5943   $self->select_for_update; #mutex
5944
5945   foreach my $cust_bill ( $self->open_cust_bill ) {
5946     my $error = $cust_bill->apply_payments_and_credits(%options);
5947     if ( $error ) {
5948       $dbh->rollback if $oldAutoCommit;
5949       return "Error applying: $error";
5950     }
5951   }
5952
5953   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5954   ''; #no error
5955
5956 }
5957
5958 =item apply_credits OPTION => VALUE ...
5959
5960 Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>)
5961 to outstanding invoice balances in chronological order (or reverse
5962 chronological order if the I<order> option is set to B<newest>) and returns the
5963 value of any remaining unapplied credits available for refund (see
5964 L<FS::cust_refund>).
5965
5966 Dies if there is an error.
5967
5968 =cut
5969
5970 sub apply_credits {
5971   my $self = shift;
5972   my %opt = @_;
5973
5974   local $SIG{HUP} = 'IGNORE';
5975   local $SIG{INT} = 'IGNORE';
5976   local $SIG{QUIT} = 'IGNORE';
5977   local $SIG{TERM} = 'IGNORE';
5978   local $SIG{TSTP} = 'IGNORE';
5979   local $SIG{PIPE} = 'IGNORE';
5980
5981   my $oldAutoCommit = $FS::UID::AutoCommit;
5982   local $FS::UID::AutoCommit = 0;
5983   my $dbh = dbh;
5984
5985   $self->select_for_update; #mutex
5986
5987   unless ( $self->total_unapplied_credits ) {
5988     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5989     return 0;
5990   }
5991
5992   my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 }
5993       qsearch('cust_credit', { 'custnum' => $self->custnum } ) );
5994
5995   my @invoices = $self->open_cust_bill;
5996   @invoices = sort { $b->_date <=> $a->_date } @invoices
5997     if defined($opt{'order'}) && $opt{'order'} eq 'newest';
5998
5999   if ( $conf->exists('pkg-balances') ) {
6000     # limit @credits to those w/ a pkgnum grepped from $self
6001     my %pkgnums = ();
6002     foreach my $i (@invoices) {
6003       foreach my $li ( $i->cust_bill_pkg ) {
6004         $pkgnums{$li->pkgnum} = 1;
6005       }
6006     }
6007     @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits;
6008   }
6009
6010   my $credit;
6011
6012   foreach my $cust_bill ( @invoices ) {
6013
6014     if ( !defined($credit) || $credit->credited == 0) {
6015       $credit = pop @credits or last;
6016     }
6017
6018     my $owed;
6019     if ( $conf->exists('pkg-balances') && $credit->pkgnum ) {
6020       $owed = $cust_bill->owed_pkgnum($credit->pkgnum);
6021     } else {
6022       $owed = $cust_bill->owed;
6023     }
6024     unless ( $owed > 0 ) {
6025       push @credits, $credit;
6026       next;
6027     }
6028
6029     my $amount = min( $credit->credited, $owed );
6030
6031     my $cust_credit_bill = new FS::cust_credit_bill ( {
6032       'crednum' => $credit->crednum,
6033       'invnum'  => $cust_bill->invnum,
6034       'amount'  => $amount,
6035     } );
6036     $cust_credit_bill->pkgnum( $credit->pkgnum )
6037       if $conf->exists('pkg-balances') && $credit->pkgnum;
6038     my $error = $cust_credit_bill->insert;
6039     if ( $error ) {
6040       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6041       die $error;
6042     }
6043
6044     redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6045
6046   }
6047
6048   my $total_unapplied_credits = $self->total_unapplied_credits;
6049
6050   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6051
6052   return $total_unapplied_credits;
6053 }
6054
6055 =item apply_payments  [ OPTION => VALUE ... ]
6056
6057 Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>)
6058 to outstanding invoice balances in chronological order.
6059
6060  #and returns the value of any remaining unapplied payments.
6061
6062 A hash of optional arguments may be passed.  Currently "manual" is supported.
6063 If true, a payment receipt is sent instead of a statement when
6064 'payment_receipt_email' configuration option is set.
6065
6066 Dies if there is an error.
6067
6068 =cut
6069
6070 sub apply_payments {
6071   my( $self, %options ) = @_;
6072
6073   local $SIG{HUP} = 'IGNORE';
6074   local $SIG{INT} = 'IGNORE';
6075   local $SIG{QUIT} = 'IGNORE';
6076   local $SIG{TERM} = 'IGNORE';
6077   local $SIG{TSTP} = 'IGNORE';
6078   local $SIG{PIPE} = 'IGNORE';
6079
6080   my $oldAutoCommit = $FS::UID::AutoCommit;
6081   local $FS::UID::AutoCommit = 0;
6082   my $dbh = dbh;
6083
6084   $self->select_for_update; #mutex
6085
6086   #return 0 unless
6087
6088   my @payments = sort { $b->_date <=> $a->_date }
6089                  grep { $_->unapplied > 0 }
6090                  $self->cust_pay;
6091
6092   my @invoices = sort { $a->_date <=> $b->_date}
6093                  grep { $_->owed > 0 }
6094                  $self->cust_bill;
6095
6096   if ( $conf->exists('pkg-balances') ) {
6097     # limit @payments to those w/ a pkgnum grepped from $self
6098     my %pkgnums = ();
6099     foreach my $i (@invoices) {
6100       foreach my $li ( $i->cust_bill_pkg ) {
6101         $pkgnums{$li->pkgnum} = 1;
6102       }
6103     }
6104     @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments;
6105   }
6106
6107   my $payment;
6108
6109   foreach my $cust_bill ( @invoices ) {
6110
6111     if ( !defined($payment) || $payment->unapplied == 0 ) {
6112       $payment = pop @payments or last;
6113     }
6114
6115     my $owed;
6116     if ( $conf->exists('pkg-balances') && $payment->pkgnum ) {
6117       $owed = $cust_bill->owed_pkgnum($payment->pkgnum);
6118     } else {
6119       $owed = $cust_bill->owed;
6120     }
6121     unless ( $owed > 0 ) {
6122       push @payments, $payment;
6123       next;
6124     }
6125
6126     my $amount = min( $payment->unapplied, $owed );
6127
6128     my $cust_bill_pay = new FS::cust_bill_pay ( {
6129       'paynum' => $payment->paynum,
6130       'invnum' => $cust_bill->invnum,
6131       'amount' => $amount,
6132     } );
6133     $cust_bill_pay->pkgnum( $payment->pkgnum )
6134       if $conf->exists('pkg-balances') && $payment->pkgnum;
6135     my $error = $cust_bill_pay->insert(%options);
6136     if ( $error ) {
6137       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
6138       die $error;
6139     }
6140
6141     redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances');
6142
6143   }
6144
6145   my $total_unapplied_payments = $self->total_unapplied_payments;
6146
6147   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
6148
6149   return $total_unapplied_payments;
6150 }
6151
6152 =item total_owed
6153
6154 Returns the total owed for this customer on all invoices
6155 (see L<FS::cust_bill/owed>).
6156
6157 =cut
6158
6159 sub total_owed {
6160   my $self = shift;
6161   $self->total_owed_date(2145859200); #12/31/2037
6162 }
6163
6164 =item total_owed_date TIME
6165
6166 Returns the total owed for this customer on all invoices with date earlier than
6167 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
6168 see L<Time::Local> and L<Date::Parse> for conversion functions.
6169
6170 =cut
6171
6172 sub total_owed_date {
6173   my $self = shift;
6174   my $time = shift;
6175
6176   my $custnum = $self->custnum;
6177
6178   my $owed_sql = FS::cust_bill->owed_sql;
6179
6180   my $sql = "
6181     SELECT SUM($owed_sql) FROM cust_bill
6182       WHERE custnum = $custnum
6183         AND _date <= $time
6184   ";
6185
6186   sprintf( "%.2f", $self->scalar_sql($sql) );
6187
6188 }
6189
6190 =item total_owed_pkgnum PKGNUM
6191
6192 Returns the total owed on all invoices for this customer's specific package
6193 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
6194
6195 =cut
6196
6197 sub total_owed_pkgnum {
6198   my( $self, $pkgnum ) = @_;
6199   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
6200 }
6201
6202 =item total_owed_date_pkgnum TIME PKGNUM
6203
6204 Returns the total owed for this customer's specific package when using
6205 experimental package balances on all invoices with date earlier than
6206 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
6207 see L<Time::Local> and L<Date::Parse> for conversion functions.
6208
6209 =cut
6210
6211 sub total_owed_date_pkgnum {
6212   my( $self, $time, $pkgnum ) = @_;
6213
6214   my $total_bill = 0;
6215   foreach my $cust_bill (
6216     grep { $_->_date <= $time }
6217       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
6218   ) {
6219     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
6220   }
6221   sprintf( "%.2f", $total_bill );
6222
6223 }
6224
6225 =item total_paid
6226
6227 Returns the total amount of all payments.
6228
6229 =cut
6230
6231 sub total_paid {
6232   my $self = shift;
6233   my $total = 0;
6234   $total += $_->paid foreach $self->cust_pay;
6235   sprintf( "%.2f", $total );
6236 }
6237
6238 =item total_unapplied_credits
6239
6240 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6241 customer.  See L<FS::cust_credit/credited>.
6242
6243 =item total_credited
6244
6245 Old name for total_unapplied_credits.  Don't use.
6246
6247 =cut
6248
6249 sub total_credited {
6250   #carp "total_credited deprecated, use total_unapplied_credits";
6251   shift->total_unapplied_credits(@_);
6252 }
6253
6254 sub total_unapplied_credits {
6255   my $self = shift;
6256
6257   my $custnum = $self->custnum;
6258
6259   my $unapplied_sql = FS::cust_credit->unapplied_sql;
6260
6261   my $sql = "
6262     SELECT SUM($unapplied_sql) FROM cust_credit
6263       WHERE custnum = $custnum
6264   ";
6265
6266   sprintf( "%.2f", $self->scalar_sql($sql) );
6267
6268 }
6269
6270 =item total_unapplied_credits_pkgnum PKGNUM
6271
6272 Returns the total outstanding credit (see L<FS::cust_credit>) for this
6273 customer.  See L<FS::cust_credit/credited>.
6274
6275 =cut
6276
6277 sub total_unapplied_credits_pkgnum {
6278   my( $self, $pkgnum ) = @_;
6279   my $total_credit = 0;
6280   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
6281   sprintf( "%.2f", $total_credit );
6282 }
6283
6284
6285 =item total_unapplied_payments
6286
6287 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
6288 See L<FS::cust_pay/unapplied>.
6289
6290 =cut
6291
6292 sub total_unapplied_payments {
6293   my $self = shift;
6294
6295   my $custnum = $self->custnum;
6296
6297   my $unapplied_sql = FS::cust_pay->unapplied_sql;
6298
6299   my $sql = "
6300     SELECT SUM($unapplied_sql) FROM cust_pay
6301       WHERE custnum = $custnum
6302   ";
6303
6304   sprintf( "%.2f", $self->scalar_sql($sql) );
6305
6306 }
6307
6308 =item total_unapplied_payments_pkgnum PKGNUM
6309
6310 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
6311 specific package when using experimental package balances.  See
6312 L<FS::cust_pay/unapplied>.
6313
6314 =cut
6315
6316 sub total_unapplied_payments_pkgnum {
6317   my( $self, $pkgnum ) = @_;
6318   my $total_unapplied = 0;
6319   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
6320   sprintf( "%.2f", $total_unapplied );
6321 }
6322
6323
6324 =item total_unapplied_refunds
6325
6326 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
6327 customer.  See L<FS::cust_refund/unapplied>.
6328
6329 =cut
6330
6331 sub total_unapplied_refunds {
6332   my $self = shift;
6333   my $custnum = $self->custnum;
6334
6335   my $unapplied_sql = FS::cust_refund->unapplied_sql;
6336
6337   my $sql = "
6338     SELECT SUM($unapplied_sql) FROM cust_refund
6339       WHERE custnum = $custnum
6340   ";
6341
6342   sprintf( "%.2f", $self->scalar_sql($sql) );
6343
6344 }
6345
6346 =item balance
6347
6348 Returns the balance for this customer (total_owed plus total_unrefunded, minus
6349 total_unapplied_credits minus total_unapplied_payments).
6350
6351 =cut
6352
6353 sub balance {
6354   my $self = shift;
6355   $self->balance_date_range;
6356 }
6357
6358 =item balance_date TIME
6359
6360 Returns the balance for this customer, only considering invoices with date
6361 earlier than TIME (total_owed_date minus total_credited minus
6362 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
6363 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
6364 functions.
6365
6366 =cut
6367
6368 sub balance_date {
6369   my $self = shift;
6370   $self->balance_date_range(shift);
6371 }
6372
6373 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
6374
6375 Returns the balance for this customer, optionally considering invoices with
6376 date earlier than START_TIME, and not later than END_TIME
6377 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
6378
6379 Times are specified as SQL fragments or numeric
6380 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
6381 L<Date::Parse> for conversion functions.  The empty string can be passed
6382 to disable that time constraint completely.
6383
6384 Available options are:
6385
6386 =over 4
6387
6388 =item unapplied_date
6389
6390 set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
6391
6392 =back
6393
6394 =cut
6395
6396 sub balance_date_range {
6397   my $self = shift;
6398   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
6399             ') FROM cust_main WHERE custnum='. $self->custnum;
6400   sprintf( '%.2f', $self->scalar_sql($sql) );
6401 }
6402
6403 =item balance_pkgnum PKGNUM
6404
6405 Returns the balance for this customer's specific package when using
6406 experimental package balances (total_owed plus total_unrefunded, minus
6407 total_unapplied_credits minus total_unapplied_payments)
6408
6409 =cut
6410
6411 sub balance_pkgnum {
6412   my( $self, $pkgnum ) = @_;
6413
6414   sprintf( "%.2f",
6415       $self->total_owed_pkgnum($pkgnum)
6416 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
6417 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
6418     - $self->total_unapplied_credits_pkgnum($pkgnum)
6419     - $self->total_unapplied_payments_pkgnum($pkgnum)
6420   );
6421 }
6422
6423 =item in_transit_payments
6424
6425 Returns the total of requests for payments for this customer pending in
6426 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
6427
6428 =cut
6429
6430 sub in_transit_payments {
6431   my $self = shift;
6432   my $in_transit_payments = 0;
6433   foreach my $pay_batch ( qsearch('pay_batch', {
6434     'status' => 'I',
6435   } ) ) {
6436     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
6437       'batchnum' => $pay_batch->batchnum,
6438       'custnum' => $self->custnum,
6439     } ) ) {
6440       $in_transit_payments += $cust_pay_batch->amount;
6441     }
6442   }
6443   sprintf( "%.2f", $in_transit_payments );
6444 }
6445
6446 =item payment_info
6447
6448 Returns a hash of useful information for making a payment.
6449
6450 =over 4
6451
6452 =item balance
6453
6454 Current balance.
6455
6456 =item payby
6457
6458 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
6459 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
6460 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
6461
6462 =back
6463
6464 For credit card transactions:
6465
6466 =over 4
6467
6468 =item card_type 1
6469
6470 =item payname
6471
6472 Exact name on card
6473
6474 =back
6475
6476 For electronic check transactions:
6477
6478 =over 4
6479
6480 =item stateid_state
6481
6482 =back
6483
6484 =cut
6485
6486 sub payment_info {
6487   my $self = shift;
6488
6489   my %return = ();
6490
6491   $return{balance} = $self->balance;
6492
6493   $return{payname} = $self->payname
6494                      || ( $self->first. ' '. $self->get('last') );
6495
6496   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
6497
6498   $return{payby} = $self->payby;
6499   $return{stateid_state} = $self->stateid_state;
6500
6501   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
6502     $return{card_type} = cardtype($self->payinfo);
6503     $return{payinfo} = $self->paymask;
6504
6505     @return{'month', 'year'} = $self->paydate_monthyear;
6506
6507   }
6508
6509   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
6510     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
6511     $return{payinfo1} = $payinfo1;
6512     $return{payinfo2} = $payinfo2;
6513     $return{paytype}  = $self->paytype;
6514     $return{paystate} = $self->paystate;
6515
6516   }
6517
6518   #doubleclick protection
6519   my $_date = time;
6520   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
6521
6522   %return;
6523
6524 }
6525
6526 =item paydate_monthyear
6527
6528 Returns a two-element list consisting of the month and year of this customer's
6529 paydate (credit card expiration date for CARD customers)
6530
6531 =cut
6532
6533 sub paydate_monthyear {
6534   my $self = shift;
6535   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
6536     ( $2, $1 );
6537   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
6538     ( $1, $3 );
6539   } else {
6540     ('', '');
6541   }
6542 }
6543
6544 =item tax_exemption TAXNAME
6545
6546 =cut
6547
6548 sub tax_exemption {
6549   my( $self, $taxname ) = @_;
6550
6551   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
6552                                      'taxname' => $taxname,
6553                                    },
6554           );
6555 }
6556
6557 =item cust_main_exemption
6558
6559 =cut
6560
6561 sub cust_main_exemption {
6562   my $self = shift;
6563   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
6564 }
6565
6566 =item invoicing_list [ ARRAYREF ]
6567
6568 If an arguement is given, sets these email addresses as invoice recipients
6569 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
6570 (except as warnings), so use check_invoicing_list first.
6571
6572 Returns a list of email addresses (with svcnum entries expanded).
6573
6574 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
6575 check it without disturbing anything by passing nothing.
6576
6577 This interface may change in the future.
6578
6579 =cut
6580
6581 sub invoicing_list {
6582   my( $self, $arrayref ) = @_;
6583
6584   if ( $arrayref ) {
6585     my @cust_main_invoice;
6586     if ( $self->custnum ) {
6587       @cust_main_invoice =
6588         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6589     } else {
6590       @cust_main_invoice = ();
6591     }
6592     foreach my $cust_main_invoice ( @cust_main_invoice ) {
6593       #warn $cust_main_invoice->destnum;
6594       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
6595         #warn $cust_main_invoice->destnum;
6596         my $error = $cust_main_invoice->delete;
6597         warn $error if $error;
6598       }
6599     }
6600     if ( $self->custnum ) {
6601       @cust_main_invoice =
6602         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6603     } else {
6604       @cust_main_invoice = ();
6605     }
6606     my %seen = map { $_->address => 1 } @cust_main_invoice;
6607     foreach my $address ( @{$arrayref} ) {
6608       next if exists $seen{$address} && $seen{$address};
6609       $seen{$address} = 1;
6610       my $cust_main_invoice = new FS::cust_main_invoice ( {
6611         'custnum' => $self->custnum,
6612         'dest'    => $address,
6613       } );
6614       my $error = $cust_main_invoice->insert;
6615       warn $error if $error;
6616     }
6617   }
6618
6619   if ( $self->custnum ) {
6620     map { $_->address }
6621       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
6622   } else {
6623     ();
6624   }
6625
6626 }
6627
6628 =item check_invoicing_list ARRAYREF
6629
6630 Checks these arguements as valid input for the invoicing_list method.  If there
6631 is an error, returns the error, otherwise returns false.
6632
6633 =cut
6634
6635 sub check_invoicing_list {
6636   my( $self, $arrayref ) = @_;
6637
6638   foreach my $address ( @$arrayref ) {
6639
6640     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
6641       return 'Can\'t add FAX invoice destination with a blank FAX number.';
6642     }
6643
6644     my $cust_main_invoice = new FS::cust_main_invoice ( {
6645       'custnum' => $self->custnum,
6646       'dest'    => $address,
6647     } );
6648     my $error = $self->custnum
6649                 ? $cust_main_invoice->check
6650                 : $cust_main_invoice->checkdest
6651     ;
6652     return $error if $error;
6653
6654   }
6655
6656   return "Email address required"
6657     if $conf->exists('cust_main-require_invoicing_list_email')
6658     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
6659
6660   '';
6661 }
6662
6663 =item set_default_invoicing_list
6664
6665 Sets the invoicing list to all accounts associated with this customer,
6666 overwriting any previous invoicing list.
6667
6668 =cut
6669
6670 sub set_default_invoicing_list {
6671   my $self = shift;
6672   $self->invoicing_list($self->all_emails);
6673 }
6674
6675 =item all_emails
6676
6677 Returns the email addresses of all accounts provisioned for this customer.
6678
6679 =cut
6680
6681 sub all_emails {
6682   my $self = shift;
6683   my %list;
6684   foreach my $cust_pkg ( $self->all_pkgs ) {
6685     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
6686     my @svc_acct =
6687       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6688         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
6689           @cust_svc;
6690     $list{$_}=1 foreach map { $_->email } @svc_acct;
6691   }
6692   keys %list;
6693 }
6694
6695 =item invoicing_list_addpost
6696
6697 Adds postal invoicing to this customer.  If this customer is already configured
6698 to receive postal invoices, does nothing.
6699
6700 =cut
6701
6702 sub invoicing_list_addpost {
6703   my $self = shift;
6704   return if grep { $_ eq 'POST' } $self->invoicing_list;
6705   my @invoicing_list = $self->invoicing_list;
6706   push @invoicing_list, 'POST';
6707   $self->invoicing_list(\@invoicing_list);
6708 }
6709
6710 =item invoicing_list_emailonly
6711
6712 Returns the list of email invoice recipients (invoicing_list without non-email
6713 destinations such as POST and FAX).
6714
6715 =cut
6716
6717 sub invoicing_list_emailonly {
6718   my $self = shift;
6719   warn "$me invoicing_list_emailonly called"
6720     if $DEBUG;
6721   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
6722 }
6723
6724 =item invoicing_list_emailonly_scalar
6725
6726 Returns the list of email invoice recipients (invoicing_list without non-email
6727 destinations such as POST and FAX) as a comma-separated scalar.
6728
6729 =cut
6730
6731 sub invoicing_list_emailonly_scalar {
6732   my $self = shift;
6733   warn "$me invoicing_list_emailonly_scalar called"
6734     if $DEBUG;
6735   join(', ', $self->invoicing_list_emailonly);
6736 }
6737
6738 =item referral_custnum_cust_main
6739
6740 Returns the customer who referred this customer (or the empty string, if
6741 this customer was not referred).
6742
6743 Note the difference with referral_cust_main method: This method,
6744 referral_custnum_cust_main returns the single customer (if any) who referred
6745 this customer, while referral_cust_main returns an array of customers referred
6746 BY this customer.
6747
6748 =cut
6749
6750 sub referral_custnum_cust_main {
6751   my $self = shift;
6752   return '' unless $self->referral_custnum;
6753   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6754 }
6755
6756 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
6757
6758 Returns an array of customers referred by this customer (referral_custnum set
6759 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
6760 customers referred by customers referred by this customer and so on, inclusive.
6761 The default behavior is DEPTH 1 (no recursion).
6762
6763 Note the difference with referral_custnum_cust_main method: This method,
6764 referral_cust_main, returns an array of customers referred BY this customer,
6765 while referral_custnum_cust_main returns the single customer (if any) who
6766 referred this customer.
6767
6768 =cut
6769
6770 sub referral_cust_main {
6771   my $self = shift;
6772   my $depth = @_ ? shift : 1;
6773   my $exclude = @_ ? shift : {};
6774
6775   my @cust_main =
6776     map { $exclude->{$_->custnum}++; $_; }
6777       grep { ! $exclude->{ $_->custnum } }
6778         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
6779
6780   if ( $depth > 1 ) {
6781     push @cust_main,
6782       map { $_->referral_cust_main($depth-1, $exclude) }
6783         @cust_main;
6784   }
6785
6786   @cust_main;
6787 }
6788
6789 =item referral_cust_main_ncancelled
6790
6791 Same as referral_cust_main, except only returns customers with uncancelled
6792 packages.
6793
6794 =cut
6795
6796 sub referral_cust_main_ncancelled {
6797   my $self = shift;
6798   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
6799 }
6800
6801 =item referral_cust_pkg [ DEPTH ]
6802
6803 Like referral_cust_main, except returns a flat list of all unsuspended (and
6804 uncancelled) packages for each customer.  The number of items in this list may
6805 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
6806
6807 =cut
6808
6809 sub referral_cust_pkg {
6810   my $self = shift;
6811   my $depth = @_ ? shift : 1;
6812
6813   map { $_->unsuspended_pkgs }
6814     grep { $_->unsuspended_pkgs }
6815       $self->referral_cust_main($depth);
6816 }
6817
6818 =item referring_cust_main
6819
6820 Returns the single cust_main record for the customer who referred this customer
6821 (referral_custnum), or false.
6822
6823 =cut
6824
6825 sub referring_cust_main {
6826   my $self = shift;
6827   return '' unless $self->referral_custnum;
6828   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
6829 }
6830
6831 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
6832
6833 Applies a credit to this customer.  If there is an error, returns the error,
6834 otherwise returns false.
6835
6836 REASON can be a text string, an FS::reason object, or a scalar reference to
6837 a reasonnum.  If a text string, it will be automatically inserted as a new
6838 reason, and a 'reason_type' option must be passed to indicate the
6839 FS::reason_type for the new reason.
6840
6841 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
6842
6843 Any other options are passed to FS::cust_credit::insert.
6844
6845 =cut
6846
6847 sub credit {
6848   my( $self, $amount, $reason, %options ) = @_;
6849
6850   my $cust_credit = new FS::cust_credit {
6851     'custnum' => $self->custnum,
6852     'amount'  => $amount,
6853   };
6854
6855   if ( ref($reason) ) {
6856
6857     if ( ref($reason) eq 'SCALAR' ) {
6858       $cust_credit->reasonnum( $$reason );
6859     } else {
6860       $cust_credit->reasonnum( $reason->reasonnum );
6861     }
6862
6863   } else {
6864     $cust_credit->set('reason', $reason)
6865   }
6866
6867   for (qw( addlinfo eventnum )) {
6868     $cust_credit->$_( delete $options{$_} )
6869       if exists($options{$_});
6870   }
6871
6872   $cust_credit->insert(%options);
6873
6874 }
6875
6876 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
6877
6878 Creates a one-time charge for this customer.  If there is an error, returns
6879 the error, otherwise returns false.
6880
6881 New-style, with a hashref of options:
6882
6883   my $error = $cust_main->charge(
6884                                   {
6885                                     'amount'     => 54.32,
6886                                     'quantity'   => 1,
6887                                     'start_date' => str2time('7/4/2009'),
6888                                     'pkg'        => 'Description',
6889                                     'comment'    => 'Comment',
6890                                     'additional' => [], #extra invoice detail
6891                                     'classnum'   => 1,  #pkg_class
6892
6893                                     'setuptax'   => '', # or 'Y' for tax exempt
6894
6895                                     #internal taxation
6896                                     'taxclass'   => 'Tax class',
6897
6898                                     #vendor taxation
6899                                     'taxproduct' => 2,  #part_pkg_taxproduct
6900                                     'override'   => {}, #XXX describe
6901
6902                                     #will be filled in with the new object
6903                                     'cust_pkg_ref' => \$cust_pkg,
6904
6905                                     #generate an invoice immediately
6906                                     'bill_now' => 0,
6907                                     'invoice_terms' => '', #with these terms
6908                                   }
6909                                 );
6910
6911 Old-style:
6912
6913   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
6914
6915 =cut
6916
6917 sub charge {
6918   my $self = shift;
6919   my ( $amount, $quantity, $start_date, $classnum );
6920   my ( $pkg, $comment, $additional );
6921   my ( $setuptax, $taxclass );   #internal taxes
6922   my ( $taxproduct, $override ); #vendor (CCH) taxes
6923   my $no_auto = '';
6924   my $cust_pkg_ref = '';
6925   my ( $bill_now, $invoice_terms ) = ( 0, '' );
6926   if ( ref( $_[0] ) ) {
6927     $amount     = $_[0]->{amount};
6928     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
6929     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
6930     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
6931     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
6932     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
6933                                            : '$'. sprintf("%.2f",$amount);
6934     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
6935     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
6936     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
6937     $additional = $_[0]->{additional} || [];
6938     $taxproduct = $_[0]->{taxproductnum};
6939     $override   = { '' => $_[0]->{tax_override} };
6940     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
6941     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
6942     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
6943   } else {
6944     $amount     = shift;
6945     $quantity   = 1;
6946     $start_date = '';
6947     $pkg        = @_ ? shift : 'One-time charge';
6948     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
6949     $setuptax   = '';
6950     $taxclass   = @_ ? shift : '';
6951     $additional = [];
6952   }
6953
6954   local $SIG{HUP} = 'IGNORE';
6955   local $SIG{INT} = 'IGNORE';
6956   local $SIG{QUIT} = 'IGNORE';
6957   local $SIG{TERM} = 'IGNORE';
6958   local $SIG{TSTP} = 'IGNORE';
6959   local $SIG{PIPE} = 'IGNORE';
6960
6961   my $oldAutoCommit = $FS::UID::AutoCommit;
6962   local $FS::UID::AutoCommit = 0;
6963   my $dbh = dbh;
6964
6965   my $part_pkg = new FS::part_pkg ( {
6966     'pkg'           => $pkg,
6967     'comment'       => $comment,
6968     'plan'          => 'flat',
6969     'freq'          => 0,
6970     'disabled'      => 'Y',
6971     'classnum'      => ( $classnum ? $classnum : '' ),
6972     'setuptax'      => $setuptax,
6973     'taxclass'      => $taxclass,
6974     'taxproductnum' => $taxproduct,
6975   } );
6976
6977   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
6978                         ( 0 .. @$additional - 1 )
6979                   ),
6980                   'additional_count' => scalar(@$additional),
6981                   'setup_fee' => $amount,
6982                 );
6983
6984   my $error = $part_pkg->insert( options       => \%options,
6985                                  tax_overrides => $override,
6986                                );
6987   if ( $error ) {
6988     $dbh->rollback if $oldAutoCommit;
6989     return $error;
6990   }
6991
6992   my $pkgpart = $part_pkg->pkgpart;
6993   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
6994   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
6995     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
6996     $error = $type_pkgs->insert;
6997     if ( $error ) {
6998       $dbh->rollback if $oldAutoCommit;
6999       return $error;
7000     }
7001   }
7002
7003   my $cust_pkg = new FS::cust_pkg ( {
7004     'custnum'    => $self->custnum,
7005     'pkgpart'    => $pkgpart,
7006     'quantity'   => $quantity,
7007     'start_date' => $start_date,
7008     'no_auto'    => $no_auto,
7009   } );
7010
7011   $error = $cust_pkg->insert;
7012   if ( $error ) {
7013     $dbh->rollback if $oldAutoCommit;
7014     return $error;
7015   } elsif ( $cust_pkg_ref ) {
7016     ${$cust_pkg_ref} = $cust_pkg;
7017   }
7018
7019   if ( $bill_now ) {
7020     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
7021                              'pkg_list'      => [ $cust_pkg ],
7022                            );
7023     if ( $error ) {
7024       $dbh->rollback if $oldAutoCommit;
7025       return $error;
7026     }
7027   }
7028
7029   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
7030   return '';
7031
7032 }
7033
7034 #=item charge_postal_fee
7035 #
7036 #Applies a one time charge this customer.  If there is an error,
7037 #returns the error, returns the cust_pkg charge object or false
7038 #if there was no charge.
7039 #
7040 #=cut
7041 #
7042 # This should be a customer event.  For that to work requires that bill
7043 # also be a customer event.
7044
7045 sub charge_postal_fee {
7046   my $self = shift;
7047
7048   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
7049   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
7050
7051   my $cust_pkg = new FS::cust_pkg ( {
7052     'custnum'  => $self->custnum,
7053     'pkgpart'  => $pkgpart,
7054     'quantity' => 1,
7055   } );
7056
7057   my $error = $cust_pkg->insert;
7058   $error ? $error : $cust_pkg;
7059 }
7060
7061 =item cust_bill
7062
7063 Returns all the invoices (see L<FS::cust_bill>) for this customer.
7064
7065 =cut
7066
7067 sub cust_bill {
7068   my $self = shift;
7069   map { $_ } #return $self->num_cust_bill unless wantarray;
7070   sort { $a->_date <=> $b->_date }
7071     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
7072 }
7073
7074 =item open_cust_bill
7075
7076 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
7077 customer.
7078
7079 =cut
7080
7081 sub open_cust_bill {
7082   my $self = shift;
7083
7084   qsearch({
7085     'table'     => 'cust_bill',
7086     'hashref'   => { 'custnum' => $self->custnum, },
7087     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
7088     'order_by'  => 'ORDER BY _date ASC',
7089   });
7090
7091 }
7092
7093 =item cust_statements
7094
7095 Returns all the statements (see L<FS::cust_statement>) for this customer.
7096
7097 =cut
7098
7099 sub cust_statement {
7100   my $self = shift;
7101   map { $_ } #return $self->num_cust_statement unless wantarray;
7102   sort { $a->_date <=> $b->_date }
7103     qsearch('cust_statement', { 'custnum' => $self->custnum, } )
7104 }
7105
7106 =item cust_credit
7107
7108 Returns all the credits (see L<FS::cust_credit>) for this customer.
7109
7110 =cut
7111
7112 sub cust_credit {
7113   my $self = shift;
7114   map { $_ } #return $self->num_cust_credit unless wantarray;
7115   sort { $a->_date <=> $b->_date }
7116     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
7117 }
7118
7119 =item cust_credit_pkgnum
7120
7121 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
7122 package when using experimental package balances.
7123
7124 =cut
7125
7126 sub cust_credit_pkgnum {
7127   my( $self, $pkgnum ) = @_;
7128   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
7129   sort { $a->_date <=> $b->_date }
7130     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
7131                               'pkgnum'  => $pkgnum,
7132                             }
7133     );
7134 }
7135
7136 =item cust_pay
7137
7138 Returns all the payments (see L<FS::cust_pay>) for this customer.
7139
7140 =cut
7141
7142 sub cust_pay {
7143   my $self = shift;
7144   return $self->num_cust_pay unless wantarray;
7145   sort { $a->_date <=> $b->_date }
7146     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
7147 }
7148
7149 =item num_cust_pay
7150
7151 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
7152 called automatically when the cust_pay method is used in a scalar context.
7153
7154 =cut
7155
7156 sub num_cust_pay {
7157   my $self = shift;
7158   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
7159   my $sth = dbh->prepare($sql) or die dbh->errstr;
7160   $sth->execute($self->custnum) or die $sth->errstr;
7161   $sth->fetchrow_arrayref->[0];
7162 }
7163
7164 =item cust_pay_pkgnum
7165
7166 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
7167 package when using experimental package balances.
7168
7169 =cut
7170
7171 sub cust_pay_pkgnum {
7172   my( $self, $pkgnum ) = @_;
7173   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
7174   sort { $a->_date <=> $b->_date }
7175     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
7176                            'pkgnum'  => $pkgnum,
7177                          }
7178     );
7179 }
7180
7181 =item cust_pay_void
7182
7183 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
7184
7185 =cut
7186
7187 sub cust_pay_void {
7188   my $self = shift;
7189   map { $_ } #return $self->num_cust_pay_void unless wantarray;
7190   sort { $a->_date <=> $b->_date }
7191     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
7192 }
7193
7194 =item cust_pay_batch
7195
7196 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
7197
7198 =cut
7199
7200 sub cust_pay_batch {
7201   my $self = shift;
7202   map { $_ } #return $self->num_cust_pay_batch unless wantarray;
7203   sort { $a->paybatchnum <=> $b->paybatchnum }
7204     qsearch( 'cust_pay_batch', { 'custnum' => $self->custnum } )
7205 }
7206
7207 =item cust_pay_pending
7208
7209 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
7210 (without status "done").
7211
7212 =cut
7213
7214 sub cust_pay_pending {
7215   my $self = shift;
7216   return $self->num_cust_pay_pending unless wantarray;
7217   sort { $a->_date <=> $b->_date }
7218     qsearch( 'cust_pay_pending', {
7219                                    'custnum' => $self->custnum,
7220                                    'status'  => { op=>'!=', value=>'done' },
7221                                  },
7222            );
7223 }
7224
7225 =item cust_pay_pending_attempt
7226
7227 Returns all payment attempts / declined payments for this customer, as pending
7228 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
7229 a corresponding payment (see L<FS::cust_pay>).
7230
7231 =cut
7232
7233 sub cust_pay_pending_attempt {
7234   my $self = shift;
7235   return $self->num_cust_pay_pending_attempt unless wantarray;
7236   sort { $a->_date <=> $b->_date }
7237     qsearch( 'cust_pay_pending', {
7238                                    'custnum' => $self->custnum,
7239                                    'status'  => 'done',
7240                                    'paynum'  => '',
7241                                  },
7242            );
7243 }
7244
7245 =item num_cust_pay_pending
7246
7247 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7248 customer (without status "done").  Also called automatically when the
7249 cust_pay_pending method is used in a scalar context.
7250
7251 =cut
7252
7253 sub num_cust_pay_pending {
7254   my $self = shift;
7255   $self->scalar_sql(
7256     " SELECT COUNT(*) FROM cust_pay_pending ".
7257       " WHERE custnum = ? AND status != 'done' ",
7258     $self->custnum
7259   );
7260 }
7261
7262 =item num_cust_pay_pending_attempt
7263
7264 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
7265 customer, with status "done" but without a corresp.  Also called automatically when the
7266 cust_pay_pending method is used in a scalar context.
7267
7268 =cut
7269
7270 sub num_cust_pay_pending_attempt {
7271   my $self = shift;
7272   $self->scalar_sql(
7273     " SELECT COUNT(*) FROM cust_pay_pending ".
7274       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
7275     $self->custnum
7276   );
7277 }
7278
7279 =item cust_refund
7280
7281 Returns all the refunds (see L<FS::cust_refund>) for this customer.
7282
7283 =cut
7284
7285 sub cust_refund {
7286   my $self = shift;
7287   map { $_ } #return $self->num_cust_refund unless wantarray;
7288   sort { $a->_date <=> $b->_date }
7289     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
7290 }
7291
7292 =item display_custnum
7293
7294 Returns the displayed customer number for this customer: agent_custid if
7295 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
7296
7297 =cut
7298
7299 sub display_custnum {
7300   my $self = shift;
7301   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
7302     return $self->agent_custid;
7303   } else {
7304     return $self->custnum;
7305   }
7306 }
7307
7308 =item name
7309
7310 Returns a name string for this customer, either "Company (Last, First)" or
7311 "Last, First".
7312
7313 =cut
7314
7315 sub name {
7316   my $self = shift;
7317   my $name = $self->contact;
7318   $name = $self->company. " ($name)" if $self->company;
7319   $name;
7320 }
7321
7322 =item ship_name
7323
7324 Returns a name string for this (service/shipping) contact, either
7325 "Company (Last, First)" or "Last, First".
7326
7327 =cut
7328
7329 sub ship_name {
7330   my $self = shift;
7331   if ( $self->get('ship_last') ) {
7332     my $name = $self->ship_contact;
7333     $name = $self->ship_company. " ($name)" if $self->ship_company;
7334     $name;
7335   } else {
7336     $self->name;
7337   }
7338 }
7339
7340 =item name_short
7341
7342 Returns a name string for this customer, either "Company" or "First Last".
7343
7344 =cut
7345
7346 sub name_short {
7347   my $self = shift;
7348   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
7349 }
7350
7351 =item ship_name_short
7352
7353 Returns a name string for this (service/shipping) contact, either "Company"
7354 or "First Last".
7355
7356 =cut
7357
7358 sub ship_name_short {
7359   my $self = shift;
7360   if ( $self->get('ship_last') ) {
7361     $self->ship_company !~ /^\s*$/
7362       ? $self->ship_company
7363       : $self->ship_contact_firstlast;
7364   } else {
7365     $self->name_company_or_firstlast;
7366   }
7367 }
7368
7369 =item contact
7370
7371 Returns this customer's full (billing) contact name only, "Last, First"
7372
7373 =cut
7374
7375 sub contact {
7376   my $self = shift;
7377   $self->get('last'). ', '. $self->first;
7378 }
7379
7380 =item ship_contact
7381
7382 Returns this customer's full (shipping) contact name only, "Last, First"
7383
7384 =cut
7385
7386 sub ship_contact {
7387   my $self = shift;
7388   $self->get('ship_last')
7389     ? $self->get('ship_last'). ', '. $self->ship_first
7390     : $self->contact;
7391 }
7392
7393 =item contact_firstlast
7394
7395 Returns this customers full (billing) contact name only, "First Last".
7396
7397 =cut
7398
7399 sub contact_firstlast {
7400   my $self = shift;
7401   $self->first. ' '. $self->get('last');
7402 }
7403
7404 =item ship_contact_firstlast
7405
7406 Returns this customer's full (shipping) contact name only, "First Last".
7407
7408 =cut
7409
7410 sub ship_contact_firstlast {
7411   my $self = shift;
7412   $self->get('ship_last')
7413     ? $self->first. ' '. $self->get('ship_last')
7414     : $self->contact_firstlast;
7415 }
7416
7417 =item country_full
7418
7419 Returns this customer's full country name
7420
7421 =cut
7422
7423 sub country_full {
7424   my $self = shift;
7425   code2country($self->country);
7426 }
7427
7428 =item geocode DATA_VENDOR
7429
7430 Returns a value for the customer location as encoded by DATA_VENDOR.
7431 Currently this only makes sense for "CCH" as DATA_VENDOR.
7432
7433 =cut
7434
7435 sub geocode {
7436   my ($self, $data_vendor) = (shift, shift);  #always cch for now
7437
7438   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
7439   return $geocode if $geocode;
7440
7441   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
7442                ? 'ship_'
7443                : '';
7444
7445   my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
7446     if $self->country eq 'US';
7447
7448   $zip ||= '';
7449   $plus4 ||= '';
7450   #CCH specific location stuff
7451   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
7452
7453   my @cust_tax_location =
7454     qsearch( {
7455                'table'     => 'cust_tax_location',
7456                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
7457                'extra_sql' => $extra_sql,
7458                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
7459              }
7460            );
7461   $geocode = $cust_tax_location[0]->geocode
7462     if scalar(@cust_tax_location);
7463
7464   $geocode;
7465 }
7466
7467 =item cust_status
7468
7469 =item status
7470
7471 Returns a status string for this customer, currently:
7472
7473 =over 4
7474
7475 =item prospect - No packages have ever been ordered
7476
7477 =item ordered - Recurring packages all are new (not yet billed).
7478
7479 =item active - One or more recurring packages is active
7480
7481 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
7482
7483 =item suspended - All non-cancelled recurring packages are suspended
7484
7485 =item cancelled - All recurring packages are cancelled
7486
7487 =back
7488
7489 =cut
7490
7491 sub status { shift->cust_status(@_); }
7492
7493 sub cust_status {
7494   my $self = shift;
7495   # prospect ordered active inactive suspended cancelled
7496   for my $status ( FS::cust_main->statuses() ) {
7497     my $method = $status.'_sql';
7498     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
7499     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
7500     $sth->execute( ($self->custnum) x $numnum )
7501       or die "Error executing 'SELECT $sql': ". $sth->errstr;
7502     return $status if $sth->fetchrow_arrayref->[0];
7503   }
7504 }
7505
7506 =item ucfirst_cust_status
7507
7508 =item ucfirst_status
7509
7510 Returns the status with the first character capitalized.
7511
7512 =cut
7513
7514 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
7515
7516 sub ucfirst_cust_status {
7517   my $self = shift;
7518   ucfirst($self->cust_status);
7519 }
7520
7521 =item statuscolor
7522
7523 Returns a hex triplet color string for this customer's status.
7524
7525 =cut
7526
7527 use vars qw(%statuscolor);
7528 tie %statuscolor, 'Tie::IxHash',
7529   'prospect'  => '7e0079', #'000000', #black?  naw, purple
7530   'active'    => '00CC00', #green
7531   'ordered'   => '009999', #teal? cyan?
7532   'inactive'  => '0000CC', #blue
7533   'suspended' => 'FF9900', #yellow
7534   'cancelled' => 'FF0000', #red
7535 ;
7536
7537 sub statuscolor { shift->cust_statuscolor(@_); }
7538
7539 sub cust_statuscolor {
7540   my $self = shift;
7541   $statuscolor{$self->cust_status};
7542 }
7543
7544 =item tickets
7545
7546 Returns an array of hashes representing the customer's RT tickets.
7547
7548 =cut
7549
7550 sub tickets {
7551   my $self = shift;
7552
7553   my $num = $conf->config('cust_main-max_tickets') || 10;
7554   my @tickets = ();
7555
7556   if ( $conf->config('ticket_system') ) {
7557     unless ( $conf->config('ticket_system-custom_priority_field') ) {
7558
7559       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
7560
7561     } else {
7562
7563       foreach my $priority (
7564         $conf->config('ticket_system-custom_priority_field-values'), ''
7565       ) {
7566         last if scalar(@tickets) >= $num;
7567         push @tickets,
7568           @{ FS::TicketSystem->customer_tickets( $self->custnum,
7569                                                  $num - scalar(@tickets),
7570                                                  $priority,
7571                                                )
7572            };
7573       }
7574     }
7575   }
7576   (@tickets);
7577 }
7578
7579 # Return services representing svc_accts in customer support packages
7580 sub support_services {
7581   my $self = shift;
7582   my %packages = map { $_ => 1 } $conf->config('support_packages');
7583
7584   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
7585     grep { $_->part_svc->svcdb eq 'svc_acct' }
7586     map { $_->cust_svc }
7587     grep { exists $packages{ $_->pkgpart } }
7588     $self->ncancelled_pkgs;
7589
7590 }
7591
7592 # Return a list of latitude/longitude for one of the services (if any)
7593 sub service_coordinates {
7594   my $self = shift;
7595
7596   my @svc_X =
7597     grep { $_->latitude && $_->longitude }
7598     map { $_->svc_x }
7599     map { $_->cust_svc }
7600     $self->ncancelled_pkgs;
7601
7602   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
7603 }
7604
7605 =back
7606
7607 =head1 CLASS METHODS
7608
7609 =over 4
7610
7611 =item statuses
7612
7613 Class method that returns the list of possible status strings for customers
7614 (see L<the status method|/status>).  For example:
7615
7616   @statuses = FS::cust_main->statuses();
7617
7618 =cut
7619
7620 sub statuses {
7621   #my $self = shift; #could be class...
7622   keys %statuscolor;
7623 }
7624
7625 =item prospect_sql
7626
7627 Returns an SQL expression identifying prospective cust_main records (customers
7628 with no packages ever ordered)
7629
7630 =cut
7631
7632 use vars qw($select_count_pkgs);
7633 $select_count_pkgs =
7634   "SELECT COUNT(*) FROM cust_pkg
7635     WHERE cust_pkg.custnum = cust_main.custnum";
7636
7637 sub select_count_pkgs_sql {
7638   $select_count_pkgs;
7639 }
7640
7641 sub prospect_sql {
7642   " 0 = ( $select_count_pkgs ) ";
7643 }
7644
7645 =item ordered_sql
7646
7647 Returns an SQL expression identifying ordered cust_main records (customers with
7648 recurring packages not yet setup).
7649
7650 =cut
7651
7652 sub ordered_sql {
7653   FS::cust_main->none_active_sql.
7654   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
7655 }
7656
7657 =item active_sql
7658
7659 Returns an SQL expression identifying active cust_main records (customers with
7660 active recurring packages).
7661
7662 =cut
7663
7664 sub active_sql {
7665   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
7666 }
7667
7668 =item none_active_sql
7669
7670 Returns an SQL expression identifying cust_main records with no active
7671 recurring packages.  This includes customers of status prospect, ordered,
7672 inactive, and suspended.
7673
7674 =cut
7675
7676 sub none_active_sql {
7677   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
7678 }
7679
7680 =item inactive_sql
7681
7682 Returns an SQL expression identifying inactive cust_main records (customers with
7683 no active recurring packages, but otherwise unsuspended/uncancelled).
7684
7685 =cut
7686
7687 sub inactive_sql {
7688   FS::cust_main->none_active_sql.
7689   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
7690 }
7691
7692 =item susp_sql
7693 =item suspended_sql
7694
7695 Returns an SQL expression identifying suspended cust_main records.
7696
7697 =cut
7698
7699
7700 sub suspended_sql { susp_sql(@_); }
7701 sub susp_sql {
7702   FS::cust_main->none_active_sql.
7703   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
7704 }
7705
7706 =item cancel_sql
7707 =item cancelled_sql
7708
7709 Returns an SQL expression identifying cancelled cust_main records.
7710
7711 =cut
7712
7713 sub cancelled_sql { cancel_sql(@_); }
7714 sub cancel_sql {
7715
7716   my $recurring_sql = FS::cust_pkg->recurring_sql;
7717   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
7718
7719   "
7720         0 < ( $select_count_pkgs )
7721     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
7722     AND 0 = ( $select_count_pkgs AND $recurring_sql
7723                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
7724             )
7725     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
7726   ";
7727
7728 }
7729
7730 =item uncancel_sql
7731 =item uncancelled_sql
7732
7733 Returns an SQL expression identifying un-cancelled cust_main records.
7734
7735 =cut
7736
7737 sub uncancelled_sql { uncancel_sql(@_); }
7738 sub uncancel_sql { "
7739   ( 0 < ( $select_count_pkgs
7740                    AND ( cust_pkg.cancel IS NULL
7741                          OR cust_pkg.cancel = 0
7742                        )
7743         )
7744     OR 0 = ( $select_count_pkgs )
7745   )
7746 "; }
7747
7748 =item balance_sql
7749
7750 Returns an SQL fragment to retreive the balance.
7751
7752 =cut
7753
7754 sub balance_sql { "
7755     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
7756         WHERE cust_bill.custnum   = cust_main.custnum     )
7757   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
7758         WHERE cust_pay.custnum    = cust_main.custnum     )
7759   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
7760         WHERE cust_credit.custnum = cust_main.custnum     )
7761   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
7762         WHERE cust_refund.custnum = cust_main.custnum     )
7763 "; }
7764
7765 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
7766
7767 Returns an SQL fragment to retreive the balance for this customer, optionally
7768 considering invoices with date earlier than START_TIME, and not
7769 later than END_TIME (total_owed_date minus total_unapplied_credits minus
7770 total_unapplied_payments).
7771
7772 Times are specified as SQL fragments or numeric
7773 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7774 L<Date::Parse> for conversion functions.  The empty string can be passed
7775 to disable that time constraint completely.
7776
7777 Available options are:
7778
7779 =over 4
7780
7781 =item unapplied_date
7782
7783 set to true to disregard unapplied credits, payments and refunds outside the specified time period - by default the time period restriction only applies to invoices (useful for reporting, probably a bad idea for event triggering)
7784
7785 =item total
7786
7787 (unused.  obsolete?)
7788 set to true to remove all customer comparison clauses, for totals
7789
7790 =item where
7791
7792 (unused.  obsolete?)
7793 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
7794
7795 =item join
7796
7797 (unused.  obsolete?)
7798 JOIN clause (typically used with the total option)
7799
7800 =item cutoff
7801
7802 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
7803 time will be ignored.  Note that START_TIME and END_TIME only limit the date
7804 range for invoices and I<unapplied> payments, credits, and refunds.
7805
7806 =back
7807
7808 =cut
7809
7810 sub balance_date_sql {
7811   my( $class, $start, $end, %opt ) = @_;
7812
7813   my $cutoff = $opt{'cutoff'};
7814
7815   my $owed         = FS::cust_bill->owed_sql($cutoff);
7816   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
7817   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
7818   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
7819
7820   my $j = $opt{'join'} || '';
7821
7822   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
7823   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
7824   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
7825   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
7826
7827   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
7828     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
7829     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
7830     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
7831   ";
7832
7833 }
7834
7835 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
7836
7837 Returns an SQL fragment to retreive the total unapplied payments for this
7838 customer, only considering invoices with date earlier than START_TIME, and
7839 optionally not later than END_TIME.
7840
7841 Times are specified as SQL fragments or numeric
7842 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
7843 L<Date::Parse> for conversion functions.  The empty string can be passed
7844 to disable that time constraint completely.
7845
7846 Available options are:
7847
7848 =cut
7849
7850 sub unapplied_payments_date_sql {
7851   my( $class, $start, $end, %opt ) = @_;
7852
7853   my $cutoff = $opt{'cutoff'};
7854
7855   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
7856
7857   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
7858                                                           'unapplied_date'=>1 );
7859
7860   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
7861 }
7862
7863 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
7864
7865 Helper method for balance_date_sql; name (and usage) subject to change
7866 (suggestions welcome).
7867
7868 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
7869 cust_refund, cust_credit or cust_pay).
7870
7871 If TABLE is "cust_bill" or the unapplied_date option is true, only
7872 considers records with date earlier than START_TIME, and optionally not
7873 later than END_TIME .
7874
7875 =cut
7876
7877 sub _money_table_where {
7878   my( $class, $table, $start, $end, %opt ) = @_;
7879
7880   my @where = ();
7881   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
7882   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
7883     push @where, "$table._date <= $start" if defined($start) && length($start);
7884     push @where, "$table._date >  $end"   if defined($end)   && length($end);
7885   }
7886   push @where, @{$opt{'where'}} if $opt{'where'};
7887   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
7888
7889   $where;
7890
7891 }
7892
7893 =item search HASHREF
7894
7895 (Class method)
7896
7897 Returns a qsearch hash expression to search for parameters specified in
7898 HASHREF.  Valid parameters are
7899
7900 =over 4
7901
7902 =item agentnum
7903
7904 =item status
7905
7906 =item cancelled_pkgs
7907
7908 bool
7909
7910 =item signupdate
7911
7912 listref of start date, end date
7913
7914 =item payby
7915
7916 listref
7917
7918 =item paydate_year
7919
7920 =item paydate_month
7921
7922 =item current_balance
7923
7924 listref (list returned by FS::UI::Web::parse_lt_gt($cgi, 'current_balance'))
7925
7926 =item cust_fields
7927
7928 =item flattened_pkgs
7929
7930 bool
7931
7932 =back
7933
7934 =cut
7935
7936 sub search {
7937   my ($class, $params) = @_;
7938
7939   my $dbh = dbh;
7940
7941   my @where = ();
7942   my $orderby;
7943
7944   ##
7945   # parse agent
7946   ##
7947
7948   if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
7949     push @where,
7950       "cust_main.agentnum = $1";
7951   }
7952
7953   ##
7954   # do the same for user
7955   ##
7956
7957   if ( $params->{'usernum'} =~ /^(\d+)$/ and $1 ) {
7958     push @where,
7959       "cust_main.usernum = $1";
7960   }
7961
7962   ##
7963   # parse status
7964   ##
7965
7966   #prospect ordered active inactive suspended cancelled
7967   if ( grep { $params->{'status'} eq $_ } FS::cust_main->statuses() ) {
7968     my $method = $params->{'status'}. '_sql';
7969     #push @where, $class->$method();
7970     push @where, FS::cust_main->$method();
7971   }
7972
7973   ##
7974   # parse cancelled package checkbox
7975   ##
7976
7977   my $pkgwhere = "";
7978
7979   $pkgwhere .= "AND (cancel = 0 or cancel is null)"
7980     unless $params->{'cancelled_pkgs'};
7981
7982   ##
7983   # parse without census tract checkbox
7984   ##
7985
7986   push @where, "(censustract = '' or censustract is null)"
7987     if $params->{'no_censustract'};
7988
7989   ##
7990   # dates
7991   ##
7992
7993   foreach my $field (qw( signupdate )) {
7994
7995     next unless exists($params->{$field});
7996
7997     my($beginning, $ending, $hour) = @{$params->{$field}};
7998
7999     push @where,
8000       "cust_main.$field IS NOT NULL",
8001       "cust_main.$field >= $beginning",
8002       "cust_main.$field <= $ending";
8003
8004     # XXX: do this for mysql and/or pull it out of here
8005     if(defined $hour) {
8006       if ($dbh->{Driver}->{Name} eq 'Pg') {
8007         push @where, "extract(hour from to_timestamp(cust_main.$field)) = $hour";
8008       }
8009       else {
8010         warn "search by time of day not supported on ".$dbh->{Driver}->{Name}." databases";
8011       }
8012     }
8013
8014     $orderby ||= "ORDER BY cust_main.$field";
8015
8016   }
8017
8018   ###
8019   # classnum
8020   ###
8021
8022   if ( $params->{'classnum'} ) {
8023
8024     my @classnum = ref( $params->{'classnum'} )
8025                      ? @{ $params->{'classnum'} }
8026                      :  ( $params->{'classnum'} );
8027
8028     @classnum = grep /^(\d*)$/, @classnum;
8029
8030     if ( @classnum ) {
8031       push @where, '( '. join(' OR ', map {
8032                                             $_ ? "cust_main.classnum = $_"
8033                                                : "cust_main.classnum IS NULL"
8034                                           }
8035                                           @classnum
8036                              ).
8037                    ' )';
8038     }
8039
8040   }
8041
8042   ###
8043   # payby
8044   ###
8045
8046   if ( $params->{'payby'} ) {
8047
8048     my @payby = ref( $params->{'payby'} )
8049                   ? @{ $params->{'payby'} }
8050                   :  ( $params->{'payby'} );
8051
8052     @payby = grep /^([A-Z]{4})$/, @{ $params->{'payby'} };
8053
8054     push @where, '( '. join(' OR ', map "cust_main.payby = '$_'", @payby). ' )'
8055       if @payby;
8056
8057   }
8058
8059   ###
8060   # paydate_year / paydate_month
8061   ###
8062
8063   if ( $params->{'paydate_year'} =~ /^(\d{4})$/ ) {
8064     my $year = $1;
8065     $params->{'paydate_month'} =~ /^(\d\d?)$/
8066       or die "paydate_year without paydate_month?";
8067     my $month = $1;
8068
8069     push @where,
8070       'paydate IS NOT NULL',
8071       "paydate != ''",
8072       "CAST(paydate AS timestamp) < CAST('$year-$month-01' AS timestamp )"
8073 ;
8074   }
8075
8076   ###
8077   # invoice terms
8078   ###
8079
8080   if ( $params->{'invoice_terms'} =~ /^([\w ]+)$/ ) {
8081     my $terms = $1;
8082     if ( $1 eq 'NULL' ) {
8083       push @where,
8084         "( cust_main.invoice_terms IS NULL OR cust_main.invoice_terms = '' )";
8085     } else {
8086       push @where,
8087         "cust_main.invoice_terms IS NOT NULL",
8088         "cust_main.invoice_terms = '$1'";
8089     }
8090   }
8091
8092   ##
8093   # amounts
8094   ##
8095
8096   if ( $params->{'current_balance'} ) {
8097
8098     #my $balance_sql = $class->balance_sql();
8099     my $balance_sql = FS::cust_main->balance_sql();
8100
8101     my @current_balance =
8102       ref( $params->{'current_balance'} )
8103       ? @{ $params->{'current_balance'} }
8104       :  ( $params->{'current_balance'} );
8105
8106     push @where, map { s/current_balance/$balance_sql/; $_ }
8107                      @current_balance;
8108
8109   }
8110
8111   ##
8112   # custbatch
8113   ##
8114
8115   if ( $params->{'custbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
8116     push @where,
8117       "cust_main.custbatch = '$1'";
8118   }
8119
8120   ##
8121   # setup queries, subs, etc. for the search
8122   ##
8123
8124   $orderby ||= 'ORDER BY custnum';
8125
8126   # here is the agent virtualization
8127   push @where, $FS::CurrentUser::CurrentUser->agentnums_sql;
8128
8129   my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
8130
8131   my $addl_from = 'LEFT JOIN cust_pkg USING ( custnum  ) ';
8132
8133   my $count_query = "SELECT COUNT(*) FROM cust_main $extra_sql";
8134
8135   my $select = join(', ',
8136                  'cust_main.custnum',
8137                  FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
8138                );
8139
8140   my(@extra_headers) = ();
8141   my(@extra_fields)  = ();
8142
8143   if ($params->{'flattened_pkgs'}) {
8144
8145     if ($dbh->{Driver}->{Name} eq 'Pg') {
8146
8147       $select .= ", array_to_string(array(select pkg from cust_pkg left join part_pkg using ( pkgpart ) where cust_main.custnum = cust_pkg.custnum $pkgwhere),'|') as magic";
8148
8149     }elsif ($dbh->{Driver}->{Name} =~ /^mysql/i) {
8150       $select .= ", GROUP_CONCAT(pkg SEPARATOR '|') as magic";
8151       $addl_from .= " LEFT JOIN part_pkg using ( pkgpart )";
8152     }else{
8153       warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
8154            "omitting packing information from report.";
8155     }
8156
8157     my $header_query = "SELECT COUNT(cust_pkg.custnum = cust_main.custnum) AS count FROM cust_main $addl_from $extra_sql $pkgwhere group by cust_main.custnum order by count desc limit 1";
8158
8159     my $sth = dbh->prepare($header_query) or die dbh->errstr;
8160     $sth->execute() or die $sth->errstr;
8161     my $headerrow = $sth->fetchrow_arrayref;
8162     my $headercount = $headerrow ? $headerrow->[0] : 0;
8163     while($headercount) {
8164       unshift @extra_headers, "Package ". $headercount;
8165       unshift @extra_fields, eval q!sub {my $c = shift;
8166                                          my @a = split '\|', $c->magic;
8167                                          my $p = $a[!.--$headercount. q!];
8168                                          $p;
8169                                         };!;
8170     }
8171
8172   }
8173
8174   my $sql_query = {
8175     'table'         => 'cust_main',
8176     'select'        => $select,
8177     'hashref'       => {},
8178     'extra_sql'     => $extra_sql,
8179     'order_by'      => $orderby,
8180     'count_query'   => $count_query,
8181     'extra_headers' => \@extra_headers,
8182     'extra_fields'  => \@extra_fields,
8183   };
8184
8185 }
8186
8187 =item email_search_result HASHREF
8188
8189 (Class method)
8190
8191 Emails a notice to the specified customers.
8192
8193 Valid parameters are those of the L<search> method, plus the following:
8194
8195 =over 4
8196
8197 =item from
8198
8199 From: address
8200
8201 =item subject
8202
8203 Email Subject:
8204
8205 =item html_body
8206
8207 HTML body
8208
8209 =item text_body
8210
8211 Text body
8212
8213 =item job
8214
8215 Optional job queue job for status updates.
8216
8217 =back
8218
8219 Returns an error message, or false for success.
8220
8221 If an error occurs during any email, stops the enture send and returns that
8222 error.  Presumably if you're getting SMTP errors aborting is better than
8223 retrying everything.
8224
8225 =cut
8226
8227 sub email_search_result {
8228   my($class, $params) = @_;
8229
8230   my $from = delete $params->{from};
8231   my $subject = delete $params->{subject};
8232   my $html_body = delete $params->{html_body};
8233   my $text_body = delete $params->{text_body};
8234   my $error = '';
8235
8236   my $job = delete $params->{'job'}
8237     or die "email_search_result must run from the job queue.\n";
8238
8239   $params->{'payby'} = [ split(/\0/, $params->{'payby'}) ]
8240     unless ref($params->{'payby'});
8241
8242   my $sql_query = $class->search($params);
8243
8244   my $count_query   = delete($sql_query->{'count_query'});
8245   my $count_sth = dbh->prepare($count_query)
8246     or die "Error preparing $count_query: ". dbh->errstr;
8247   $count_sth->execute
8248     or die "Error executing $count_query: ". $count_sth->errstr;
8249   my $count_arrayref = $count_sth->fetchrow_arrayref;
8250   my $num_cust = $count_arrayref->[0];
8251
8252   #my @extra_headers = @{ delete($sql_query->{'extra_headers'}) };
8253   #my @extra_fields  = @{ delete($sql_query->{'extra_fields'})  };
8254
8255
8256   my( $num, $last, $min_sec ) = (0, time, 5); #progresbar foo
8257   my @retry_jobs = ();
8258   my $success = 0;
8259
8260   #eventually order+limit magic to reduce memory use?
8261   foreach my $cust_main ( qsearch($sql_query) ) {
8262
8263     #progressbar first, so that the count is right
8264     $num++;
8265     if ( time - $min_sec > $last ) {
8266       my $error = $job->update_statustext(
8267         int( 100 * $num / $num_cust )
8268       );
8269       die $error if $error;
8270       $last = time;
8271     }
8272
8273     my $to = $cust_main->invoicing_list_emailonly_scalar;
8274
8275     if( $to ) {
8276       my @message = (
8277         'from'      => $from,
8278         'to'        => $to,
8279         'subject'   => $subject,
8280         'html_body' => $html_body,
8281         'text_body' => $text_body,
8282       );
8283
8284       $error = send_email( generate_email( @message ) );
8285
8286       if($error) {
8287         # queue the sending of this message so that the user can see what we
8288         # tried to do, and retry if desired
8289         my $queue = new FS::queue {
8290           'job'        => 'FS::Misc::process_send_email',
8291           'custnum'    => $cust_main->custnum,
8292           'status'     => 'failed',
8293           'statustext' => $error,
8294         };
8295         $queue->insert(@message);
8296         push @retry_jobs, $queue;
8297       }
8298       else {
8299         $success++;
8300       }
8301     }
8302
8303     if($success == 0 and
8304         (scalar(@retry_jobs) > 10 or $num == $num_cust)
8305       ) {
8306       # 10 is arbitrary, but if we have enough failures, that's
8307       # probably a configuration or network problem, and we
8308       # abort the batch and run away screaming.
8309       # We NEVER do this if anything was successfully sent.
8310       $_->delete foreach (@retry_jobs);
8311       return "multiple failures: '$error'\n";
8312     }
8313   }
8314
8315   if(@retry_jobs) {
8316     # fail the job, but with a status message that makes it clear
8317     # something was sent.
8318     return "Sent $success, failed ".scalar(@retry_jobs).". Failed attempts placed in job queue.\n";
8319   }
8320
8321   return '';
8322 }
8323
8324 sub process_email_search_result {
8325   my $job = shift;
8326   #warn "$me process_re_X $method for job $job\n" if $DEBUG;
8327
8328   my $param = thaw(decode_base64(shift));
8329   warn Dumper($param) if $DEBUG;
8330
8331   $param->{'job'} = $job;
8332
8333   $param->{'payby'} = [ split(/\0/, $param->{'payby'}) ]
8334     unless ref($param->{'payby'});
8335
8336   my $error = FS::cust_main->email_search_result( $param );
8337   die $error if $error;
8338
8339 }
8340
8341 =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ]
8342
8343 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
8344 records.  Currently, I<first>, I<last>, I<company> and/or I<address1> may be
8345 specified (the appropriate ship_ field is also searched).
8346
8347 Additional options are the same as FS::Record::qsearch
8348
8349 =cut
8350
8351 sub fuzzy_search {
8352   my( $self, $fuzzy, $hash, @opt) = @_;
8353   #$self
8354   $hash ||= {};
8355   my @cust_main = ();
8356
8357   check_and_rebuild_fuzzyfiles();
8358   foreach my $field ( keys %$fuzzy ) {
8359
8360     my $all = $self->all_X($field);
8361     next unless scalar(@$all);
8362
8363     my %match = ();
8364     $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, ['i'], @$all ) );
8365
8366     my @fcust = ();
8367     foreach ( keys %match ) {
8368       push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt);
8369       push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt);
8370     }
8371     my %fsaw = ();
8372     push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust;
8373   }
8374
8375   # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
8376   my %saw = ();
8377   @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
8378
8379   @cust_main;
8380
8381 }
8382
8383 =item masked FIELD
8384
8385 Returns a masked version of the named field
8386
8387 =cut
8388
8389 sub masked {
8390 my ($self,$field) = @_;
8391
8392 # Show last four
8393
8394 'x'x(length($self->getfield($field))-4).
8395   substr($self->getfield($field), (length($self->getfield($field))-4));
8396
8397 }
8398
8399 =back
8400
8401 =head1 SUBROUTINES
8402
8403 =over 4
8404
8405 =item smart_search OPTION => VALUE ...
8406
8407 Accepts the following options: I<search>, the string to search for.  The string
8408 will be searched for as a customer number, phone number, name or company name,
8409 as an exact, or, in some cases, a substring or fuzzy match (see the source code
8410 for the exact heuristics used); I<no_fuzzy_on_exact>, causes smart_search to
8411 skip fuzzy matching when an exact match is found.
8412
8413 Any additional options are treated as an additional qualifier on the search
8414 (i.e. I<agentnum>).
8415
8416 Returns a (possibly empty) array of FS::cust_main objects.
8417
8418 =cut
8419
8420 sub smart_search {
8421   my %options = @_;
8422
8423   #here is the agent virtualization
8424   my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8425
8426   my @cust_main = ();
8427
8428   my $skip_fuzzy = delete $options{'no_fuzzy_on_exact'};
8429   my $search = delete $options{'search'};
8430   ( my $alphanum_search = $search ) =~ s/\W//g;
8431
8432   if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search
8433
8434     #false laziness w/Record::ut_phone
8435     my $phonen = "$1-$2-$3";
8436     $phonen .= " x$4" if $4;
8437
8438     push @cust_main, qsearch( {
8439       'table'   => 'cust_main',
8440       'hashref' => { %options },
8441       'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8442                      ' ( '.
8443                          join(' OR ', map "$_ = '$phonen'",
8444                                           qw( daytime night fax
8445                                               ship_daytime ship_night ship_fax )
8446                              ).
8447                      ' ) '.
8448                      " AND $agentnums_sql", #agent virtualization
8449     } );
8450
8451     unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match
8452       #try looking for matches with extensions unless one was specified
8453
8454       push @cust_main, qsearch( {
8455         'table'   => 'cust_main',
8456         'hashref' => { %options },
8457         'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ).
8458                        ' ( '.
8459                            join(' OR ', map "$_ LIKE '$phonen\%'",
8460                                             qw( daytime night
8461                                                 ship_daytime ship_night )
8462                                ).
8463                        ' ) '.
8464                        " AND $agentnums_sql", #agent virtualization
8465       } );
8466
8467     }
8468
8469   # custnum search (also try agent_custid), with some tweaking options if your
8470   # legacy cust "numbers" have letters
8471   }
8472
8473   if ( $search =~ /^\s*(\d+)\s*$/
8474          || ( $conf->config('cust_main-agent_custid-format') eq 'ww?d+'
8475               && $search =~ /^\s*(\w\w?\d+)\s*$/
8476             )
8477          || ( $conf->exists('address1-search' )
8478               && $search =~ /^\s*(\d+\-?\w*)\s*$/ #i.e. 1234A or 9432-D
8479             )
8480      )
8481   {
8482
8483     my $num = $1;
8484
8485     if ( $num =~ /^(\d+)$/ && $num <= 2147483647 ) { #need a bigint custnum? wow
8486       push @cust_main, qsearch( {
8487         'table'     => 'cust_main',
8488         'hashref'   => { 'custnum' => $num, %options },
8489         'extra_sql' => " AND $agentnums_sql", #agent virtualization
8490       } );
8491     }
8492
8493     push @cust_main, qsearch( {
8494       'table'     => 'cust_main',
8495       'hashref'   => { 'agent_custid' => $num, %options },
8496       'extra_sql' => " AND $agentnums_sql", #agent virtualization
8497     } );
8498
8499     if ( $conf->exists('address1-search') ) {
8500       my $len = length($num);
8501       $num = lc($num);
8502       foreach my $prefix ( '', 'ship_' ) {
8503         push @cust_main, qsearch( {
8504           'table'     => 'cust_main',
8505           'hashref'   => { %options, },
8506           'extra_sql' =>
8507             ( keys(%options) ? ' AND ' : ' WHERE ' ).
8508             " LOWER(SUBSTRING(${prefix}address1 FROM 1 FOR $len)) = '$num' ".
8509             " AND $agentnums_sql",
8510         } );
8511       }
8512     }
8513
8514   } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) {
8515
8516     my($company, $last, $first) = ( $1, $2, $3 );
8517
8518     # "Company (Last, First)"
8519     #this is probably something a browser remembered,
8520     #so just do an exact search (but case-insensitive, so USPS standardization
8521     #doesn't throw a wrench in the works)
8522
8523     foreach my $prefix ( '', 'ship_' ) {
8524       push @cust_main, qsearch( {
8525         'table'     => 'cust_main',
8526         'hashref'   => { %options },
8527         'extra_sql' =>
8528           ( keys(%options) ? ' AND ' : ' WHERE ' ).
8529           join(' AND ',
8530             " LOWER(${prefix}first)   = ". dbh->quote(lc($first)),
8531             " LOWER(${prefix}last)    = ". dbh->quote(lc($last)),
8532             " LOWER(${prefix}company) = ". dbh->quote(lc($company)),
8533             $agentnums_sql,
8534           ),
8535       } );
8536     }
8537
8538   } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search
8539                                               # try (ship_){last,company}
8540
8541     my $value = lc($1);
8542
8543     # # remove "(Last, First)" in "Company (Last, First)", otherwise the
8544     # # full strings the browser remembers won't work
8545     # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name
8546
8547     use Lingua::EN::NameParse;
8548     my $NameParse = new Lingua::EN::NameParse(
8549              auto_clean     => 1,
8550              allow_reversed => 1,
8551     );
8552
8553     my($last, $first) = ( '', '' );
8554     #maybe disable this too and just rely on NameParse?
8555     if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First
8556
8557       ($last, $first) = ( $1, $2 );
8558
8559     #} elsif  ( $value =~ /^(.+)\s+(.+)$/ ) {
8560     } elsif ( ! $NameParse->parse($value) ) {
8561
8562       my %name = $NameParse->components;
8563       $first = $name{'given_name_1'};
8564       $last  = $name{'surname_1'};
8565
8566     }
8567
8568     if ( $first && $last ) {
8569
8570       my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) );
8571
8572       #exact
8573       my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8574       $sql .= "
8575         (     ( LOWER(last) = $q_last AND LOWER(first) = $q_first )
8576            OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first )
8577         )";
8578
8579       push @cust_main, qsearch( {
8580         'table'     => 'cust_main',
8581         'hashref'   => \%options,
8582         'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8583       } );
8584
8585       # or it just be something that was typed in... (try that in a sec)
8586
8587     }
8588
8589     my $q_value = dbh->quote($value);
8590
8591     #exact
8592     my $sql = scalar(keys %options) ? ' AND ' : ' WHERE ';
8593     $sql .= " (    LOWER(last)          = $q_value
8594                 OR LOWER(company)       = $q_value
8595                 OR LOWER(ship_last)     = $q_value
8596                 OR LOWER(ship_company)  = $q_value
8597             ";
8598     $sql .= "   OR LOWER(address1)      = $q_value
8599                 OR LOWER(ship_address1) = $q_value
8600             "
8601       if $conf->exists('address1-search');
8602     $sql .= " )";
8603
8604     push @cust_main, qsearch( {
8605       'table'     => 'cust_main',
8606       'hashref'   => \%options,
8607       'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization
8608     } );
8609
8610     #no exact match, trying substring/fuzzy
8611     #always do substring & fuzzy (unless they're explicity config'ed off)
8612     #getting complaints searches are not returning enough
8613     unless ( @cust_main  && $skip_fuzzy || $conf->exists('disable-fuzzy') ) {
8614
8615       #still some false laziness w/search (was search/cust_main.cgi)
8616
8617       #substring
8618
8619       my @hashrefs = (
8620         { 'company'      => { op=>'ILIKE', value=>"%$value%" }, },
8621         { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, },
8622       );
8623
8624       if ( $first && $last ) {
8625
8626         push @hashrefs,
8627           { 'first'        => { op=>'ILIKE', value=>"%$first%" },
8628             'last'         => { op=>'ILIKE', value=>"%$last%" },
8629           },
8630           { 'ship_first'   => { op=>'ILIKE', value=>"%$first%" },
8631             'ship_last'    => { op=>'ILIKE', value=>"%$last%" },
8632           },
8633         ;
8634
8635       } else {
8636
8637         push @hashrefs,
8638           { 'last'         => { op=>'ILIKE', value=>"%$value%" }, },
8639           { 'ship_last'    => { op=>'ILIKE', value=>"%$value%" }, },
8640         ;
8641       }
8642
8643       if ( $conf->exists('address1-search') ) {
8644         push @hashrefs,
8645           { 'address1'      => { op=>'ILIKE', value=>"%$value%" }, },
8646           { 'ship_address1' => { op=>'ILIKE', value=>"%$value%" }, },
8647         ;
8648       }
8649
8650       foreach my $hashref ( @hashrefs ) {
8651
8652         push @cust_main, qsearch( {
8653           'table'     => 'cust_main',
8654           'hashref'   => { %$hashref,
8655                            %options,
8656                          },
8657           'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton
8658         } );
8659
8660       }
8661
8662       #fuzzy
8663       my @fuzopts = (
8664         \%options,                #hashref
8665         '',                       #select
8666         " AND $agentnums_sql",    #extra_sql  #agent virtualization
8667       );
8668
8669       if ( $first && $last ) {
8670         push @cust_main, FS::cust_main->fuzzy_search(
8671           { 'last'   => $last,    #fuzzy hashref
8672             'first'  => $first }, #
8673           @fuzopts
8674         );
8675       }
8676       foreach my $field ( 'last', 'company' ) {
8677         push @cust_main,
8678           FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts );
8679       }
8680       if ( $conf->exists('address1-search') ) {
8681         push @cust_main,
8682           FS::cust_main->fuzzy_search( { 'address1' => $value }, @fuzopts );
8683       }
8684
8685     }
8686
8687   }
8688
8689   #eliminate duplicates
8690   my %saw = ();
8691   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8692
8693   @cust_main;
8694
8695 }
8696
8697 =item email_search
8698
8699 Accepts the following options: I<email>, the email address to search for.  The
8700 email address will be searched for as an email invoice destination and as an
8701 svc_acct account.
8702
8703 #Any additional options are treated as an additional qualifier on the search
8704 #(i.e. I<agentnum>).
8705
8706 Returns a (possibly empty) array of FS::cust_main objects (but usually just
8707 none or one).
8708
8709 =cut
8710
8711 sub email_search {
8712   my %options = @_;
8713
8714   local($DEBUG) = 1;
8715
8716   my $email = delete $options{'email'};
8717
8718   #we're only being used by RT at the moment... no agent virtualization yet
8719   #my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql;
8720
8721   my @cust_main = ();
8722
8723   if ( $email =~ /([^@]+)\@([^@]+)/ ) {
8724
8725     my ( $user, $domain ) = ( $1, $2 );
8726
8727     warn "$me smart_search: searching for $user in domain $domain"
8728       if $DEBUG;
8729
8730     push @cust_main,
8731       map $_->cust_main,
8732           qsearch( {
8733                      'table'     => 'cust_main_invoice',
8734                      'hashref'   => { 'dest' => $email },
8735                    }
8736                  );
8737
8738     push @cust_main,
8739       map  $_->cust_main,
8740       grep $_,
8741       map  $_->cust_svc->cust_pkg,
8742           qsearch( {
8743                      'table'     => 'svc_acct',
8744                      'hashref'   => { 'username' => $user, },
8745                      'extra_sql' =>
8746                        'AND ( SELECT domain FROM svc_domain
8747                                 WHERE svc_acct.domsvc = svc_domain.svcnum
8748                             ) = '. dbh->quote($domain),
8749                    }
8750                  );
8751   }
8752
8753   my %saw = ();
8754   @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
8755
8756   warn "$me smart_search: found ". scalar(@cust_main). " unique customers"
8757     if $DEBUG;
8758
8759   @cust_main;
8760
8761 }
8762
8763 =item check_and_rebuild_fuzzyfiles
8764
8765 =cut
8766
8767 sub check_and_rebuild_fuzzyfiles {
8768   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8769   rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields
8770 }
8771
8772 =item rebuild_fuzzyfiles
8773
8774 =cut
8775
8776 sub rebuild_fuzzyfiles {
8777
8778   use Fcntl qw(:flock);
8779
8780   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8781   mkdir $dir, 0700 unless -d $dir;
8782
8783   foreach my $fuzzy ( @fuzzyfields ) {
8784
8785     open(LOCK,">>$dir/cust_main.$fuzzy")
8786       or die "can't open $dir/cust_main.$fuzzy: $!";
8787     flock(LOCK,LOCK_EX)
8788       or die "can't lock $dir/cust_main.$fuzzy: $!";
8789
8790     open (CACHE,">$dir/cust_main.$fuzzy.tmp")
8791       or die "can't open $dir/cust_main.$fuzzy.tmp: $!";
8792
8793     foreach my $field ( $fuzzy, "ship_$fuzzy" ) {
8794       my $sth = dbh->prepare("SELECT $field FROM cust_main".
8795                              " WHERE $field != '' AND $field IS NOT NULL");
8796       $sth->execute or die $sth->errstr;
8797
8798       while ( my $row = $sth->fetchrow_arrayref ) {
8799         print CACHE $row->[0]. "\n";
8800       }
8801
8802     }
8803
8804     close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!";
8805
8806     rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy";
8807     close LOCK;
8808   }
8809
8810 }
8811
8812 =item all_X
8813
8814 =cut
8815
8816 sub all_X {
8817   my( $self, $field ) = @_;
8818   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8819   open(CACHE,"<$dir/cust_main.$field")
8820     or die "can't open $dir/cust_main.$field: $!";
8821   my @array = map { chomp; $_; } <CACHE>;
8822   close CACHE;
8823   \@array;
8824 }
8825
8826 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
8827
8828 =cut
8829
8830 sub append_fuzzyfiles {
8831   #my( $first, $last, $company ) = @_;
8832
8833   &check_and_rebuild_fuzzyfiles;
8834
8835   use Fcntl qw(:flock);
8836
8837   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
8838
8839   foreach my $field (@fuzzyfields) {
8840     my $value = shift;
8841
8842     if ( $value ) {
8843
8844       open(CACHE,">>$dir/cust_main.$field")
8845         or die "can't open $dir/cust_main.$field: $!";
8846       flock(CACHE,LOCK_EX)
8847         or die "can't lock $dir/cust_main.$field: $!";
8848
8849       print CACHE "$value\n";
8850
8851       flock(CACHE,LOCK_UN)
8852         or die "can't unlock $dir/cust_main.$field: $!";
8853       close CACHE;
8854     }
8855
8856   }
8857
8858   1;
8859 }
8860
8861 =item batch_charge
8862
8863 =cut
8864
8865 sub batch_charge {
8866   my $param = shift;
8867   #warn join('-',keys %$param);
8868   my $fh = $param->{filehandle};
8869   my @fields = @{$param->{fields}};
8870
8871   eval "use Text::CSV_XS;";
8872   die $@ if $@;
8873
8874   my $csv = new Text::CSV_XS;
8875   #warn $csv;
8876   #warn $fh;
8877
8878   my $imported = 0;
8879   #my $columns;
8880
8881   local $SIG{HUP} = 'IGNORE';
8882   local $SIG{INT} = 'IGNORE';
8883   local $SIG{QUIT} = 'IGNORE';
8884   local $SIG{TERM} = 'IGNORE';
8885   local $SIG{TSTP} = 'IGNORE';
8886   local $SIG{PIPE} = 'IGNORE';
8887
8888   my $oldAutoCommit = $FS::UID::AutoCommit;
8889   local $FS::UID::AutoCommit = 0;
8890   my $dbh = dbh;
8891
8892   #while ( $columns = $csv->getline($fh) ) {
8893   my $line;
8894   while ( defined($line=<$fh>) ) {
8895
8896     $csv->parse($line) or do {
8897       $dbh->rollback if $oldAutoCommit;
8898       return "can't parse: ". $csv->error_input();
8899     };
8900
8901     my @columns = $csv->fields();
8902     #warn join('-',@columns);
8903
8904     my %row = ();
8905     foreach my $field ( @fields ) {
8906       $row{$field} = shift @columns;
8907     }
8908
8909     my $cust_main = qsearchs('cust_main', { 'custnum' => $row{'custnum'} } );
8910     unless ( $cust_main ) {
8911       $dbh->rollback if $oldAutoCommit;
8912       return "unknown custnum $row{'custnum'}";
8913     }
8914
8915     if ( $row{'amount'} > 0 ) {
8916       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
8917       if ( $error ) {
8918         $dbh->rollback if $oldAutoCommit;
8919         return $error;
8920       }
8921       $imported++;
8922     } elsif ( $row{'amount'} < 0 ) {
8923       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
8924                                       $row{'pkg'}                         );
8925       if ( $error ) {
8926         $dbh->rollback if $oldAutoCommit;
8927         return $error;
8928       }
8929       $imported++;
8930     } else {
8931       #hmm?
8932     }
8933
8934   }
8935
8936   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
8937
8938   return "Empty file!" unless $imported;
8939
8940   ''; #no error
8941
8942 }
8943
8944 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
8945
8946 Deprecated.  Use event notification and message templates
8947 (L<FS::msg_template>) instead.
8948
8949 Sends a templated email notification to the customer (see L<Text::Template>).
8950
8951 OPTIONS is a hash and may include
8952
8953 I<from> - the email sender (default is invoice_from)
8954
8955 I<to> - comma-separated scalar or arrayref of recipients
8956    (default is invoicing_list)
8957
8958 I<subject> - The subject line of the sent email notification
8959    (default is "Notice from company_name")
8960
8961 I<extra_fields> - a hashref of name/value pairs which will be substituted
8962    into the template
8963
8964 The following variables are vavailable in the template.
8965
8966 I<$first> - the customer first name
8967 I<$last> - the customer last name
8968 I<$company> - the customer company
8969 I<$payby> - a description of the method of payment for the customer
8970             # would be nice to use FS::payby::shortname
8971 I<$payinfo> - the account information used to collect for this customer
8972 I<$expdate> - the expiration of the customer payment in seconds from epoch
8973
8974 =cut
8975
8976 sub notify {
8977   my ($self, $template, %options) = @_;
8978
8979   return unless $conf->exists($template);
8980
8981   my $from = $conf->config('invoice_from', $self->agentnum)
8982     if $conf->exists('invoice_from', $self->agentnum);
8983   $from = $options{from} if exists($options{from});
8984
8985   my $to = join(',', $self->invoicing_list_emailonly);
8986   $to = $options{to} if exists($options{to});
8987
8988   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
8989     if $conf->exists('company_name', $self->agentnum);
8990   $subject = $options{subject} if exists($options{subject});
8991
8992   my $notify_template = new Text::Template (TYPE => 'ARRAY',
8993                                             SOURCE => [ map "$_\n",
8994                                               $conf->config($template)]
8995                                            )
8996     or die "can't create new Text::Template object: Text::Template::ERROR";
8997   $notify_template->compile()
8998     or die "can't compile template: Text::Template::ERROR";
8999
9000   $FS::notify_template::_template::company_name =
9001     $conf->config('company_name', $self->agentnum);
9002   $FS::notify_template::_template::company_address =
9003     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
9004
9005   my $paydate = $self->paydate || '2037-12-31';
9006   $FS::notify_template::_template::first = $self->first;
9007   $FS::notify_template::_template::last = $self->last;
9008   $FS::notify_template::_template::company = $self->company;
9009   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
9010   my $payby = $self->payby;
9011   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9012   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9013
9014   #credit cards expire at the end of the month/year of their exp date
9015   if ($payby eq 'CARD' || $payby eq 'DCRD') {
9016     $FS::notify_template::_template::payby = 'credit card';
9017     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9018     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9019     $expire_time--;
9020   }elsif ($payby eq 'COMP') {
9021     $FS::notify_template::_template::payby = 'complimentary account';
9022   }else{
9023     $FS::notify_template::_template::payby = 'current method';
9024   }
9025   $FS::notify_template::_template::expdate = $expire_time;
9026
9027   for (keys %{$options{extra_fields}}){
9028     no strict "refs";
9029     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
9030   }
9031
9032   send_email(from => $from,
9033              to => $to,
9034              subject => $subject,
9035              body => $notify_template->fill_in( PACKAGE =>
9036                                                 'FS::notify_template::_template'                                              ),
9037             );
9038
9039 }
9040
9041 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
9042
9043 Generates a templated notification to the customer (see L<Text::Template>).
9044
9045 OPTIONS is a hash and may include
9046
9047 I<extra_fields> - a hashref of name/value pairs which will be substituted
9048    into the template.  These values may override values mentioned below
9049    and those from the customer record.
9050
9051 The following variables are available in the template instead of or in addition
9052 to the fields of the customer record.
9053
9054 I<$payby> - a description of the method of payment for the customer
9055             # would be nice to use FS::payby::shortname
9056 I<$payinfo> - the masked account information used to collect for this customer
9057 I<$expdate> - the expiration of the customer payment method in seconds from epoch
9058 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
9059
9060 =cut
9061
9062 # a lot like cust_bill::print_latex
9063 sub generate_letter {
9064   my ($self, $template, %options) = @_;
9065
9066   return unless $conf->exists($template);
9067
9068   my $letter_template = new Text::Template
9069                         ( TYPE       => 'ARRAY',
9070                           SOURCE     => [ map "$_\n", $conf->config($template)],
9071                           DELIMITERS => [ '[@--', '--@]' ],
9072                         )
9073     or die "can't create new Text::Template object: Text::Template::ERROR";
9074
9075   $letter_template->compile()
9076     or die "can't compile template: Text::Template::ERROR";
9077
9078   my %letter_data = map { $_ => $self->$_ } $self->fields;
9079   $letter_data{payinfo} = $self->mask_payinfo;
9080
9081   #my $paydate = $self->paydate || '2037-12-31';
9082   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
9083
9084   my $payby = $self->payby;
9085   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
9086   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
9087
9088   #credit cards expire at the end of the month/year of their exp date
9089   if ($payby eq 'CARD' || $payby eq 'DCRD') {
9090     $letter_data{payby} = 'credit card';
9091     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
9092     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
9093     $expire_time--;
9094   }elsif ($payby eq 'COMP') {
9095     $letter_data{payby} = 'complimentary account';
9096   }else{
9097     $letter_data{payby} = 'current method';
9098   }
9099   $letter_data{expdate} = $expire_time;
9100
9101   for (keys %{$options{extra_fields}}){
9102     $letter_data{$_} = $options{extra_fields}->{$_};
9103   }
9104
9105   unless(exists($letter_data{returnaddress})){
9106     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
9107                                                   $self->agent_template)
9108                      );
9109     if ( length($retadd) ) {
9110       $letter_data{returnaddress} = $retadd;
9111     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
9112       $letter_data{returnaddress} =
9113         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
9114                           s/$/\\\\\*/;
9115                           $_;
9116                         }
9117                     ( $conf->config('company_name', $self->agentnum),
9118                       $conf->config('company_address', $self->agentnum),
9119                     )
9120         );
9121     } else {
9122       $letter_data{returnaddress} = '~';
9123     }
9124   }
9125
9126   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
9127
9128   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
9129
9130   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
9131
9132   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
9133                            DIR      => $dir,
9134                            SUFFIX   => '.eps',
9135                            UNLINK   => 0,
9136                          ) or die "can't open temp file: $!\n";
9137   print $lh $conf->config_binary('logo.eps', $self->agentnum)
9138     or die "can't write temp file: $!\n";
9139   close $lh;
9140   $letter_data{'logo_file'} = $lh->filename;
9141
9142   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
9143                            DIR      => $dir,
9144                            SUFFIX   => '.tex',
9145                            UNLINK   => 0,
9146                          ) or die "can't open temp file: $!\n";
9147
9148   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
9149   close $fh;
9150   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
9151   return ($1, $letter_data{'logo_file'});
9152
9153 }
9154
9155 =item print_ps TEMPLATE
9156
9157 Returns an postscript letter filled in from TEMPLATE, as a scalar.
9158
9159 =cut
9160
9161 sub print_ps {
9162   my $self = shift;
9163   my($file, $lfile) = $self->generate_letter(@_);
9164   my $ps = FS::Misc::generate_ps($file);
9165   unlink($file.'.tex');
9166   unlink($lfile);
9167
9168   $ps;
9169 }
9170
9171 =item print TEMPLATE
9172
9173 Prints the filled in template.
9174
9175 TEMPLATE is the name of a L<Text::Template> to fill in and print.
9176
9177 =cut
9178
9179 sub queueable_print {
9180   my %opt = @_;
9181
9182   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
9183     or die "invalid customer number: " . $opt{custvnum};
9184
9185   my $error = $self->print( $opt{template} );
9186   die $error if $error;
9187 }
9188
9189 sub print {
9190   my ($self, $template) = (shift, shift);
9191   do_print [ $self->print_ps($template) ];
9192 }
9193
9194 #these three subs should just go away once agent stuff is all config overrides
9195
9196 sub agent_template {
9197   my $self = shift;
9198   $self->_agent_plandata('agent_templatename');
9199 }
9200
9201 sub agent_invoice_from {
9202   my $self = shift;
9203   $self->_agent_plandata('agent_invoice_from');
9204 }
9205
9206 sub _agent_plandata {
9207   my( $self, $option ) = @_;
9208
9209   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
9210   #agent-specific Conf
9211
9212   use FS::part_event::Condition;
9213
9214   my $agentnum = $self->agentnum;
9215
9216   my $regexp = regexp_sql();
9217
9218   my $part_event_option =
9219     qsearchs({
9220       'select'    => 'part_event_option.*',
9221       'table'     => 'part_event_option',
9222       'addl_from' => q{
9223         LEFT JOIN part_event USING ( eventpart )
9224         LEFT JOIN part_event_option AS peo_agentnum
9225           ON ( part_event.eventpart = peo_agentnum.eventpart
9226                AND peo_agentnum.optionname = 'agentnum'
9227                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
9228              )
9229         LEFT JOIN part_event_condition
9230           ON ( part_event.eventpart = part_event_condition.eventpart
9231                AND part_event_condition.conditionname = 'cust_bill_age'
9232              )
9233         LEFT JOIN part_event_condition_option
9234           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
9235                AND part_event_condition_option.optionname = 'age'
9236              )
9237       },
9238       #'hashref'   => { 'optionname' => $option },
9239       #'hashref'   => { 'part_event_option.optionname' => $option },
9240       'extra_sql' =>
9241         " WHERE part_event_option.optionname = ". dbh->quote($option).
9242         " AND action = 'cust_bill_send_agent' ".
9243         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
9244         " AND peo_agentnum.optionname = 'agentnum' ".
9245         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
9246         " ORDER BY
9247            CASE WHEN part_event_condition_option.optionname IS NULL
9248            THEN -1
9249            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
9250         " END
9251           , part_event.weight".
9252         " LIMIT 1"
9253     });
9254
9255   unless ( $part_event_option ) {
9256     return $self->agent->invoice_template || ''
9257       if $option eq 'agent_templatename';
9258     return '';
9259   }
9260
9261   $part_event_option->optionvalue;
9262
9263 }
9264
9265 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
9266
9267 Subroutine (not a method), designed to be called from the queue.
9268
9269 Takes a list of options and values.
9270
9271 Pulls up the customer record via the custnum option and calls bill_and_collect.
9272
9273 =cut
9274
9275 sub queued_bill {
9276   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
9277
9278   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
9279   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
9280
9281   $cust_main->bill_and_collect( %args );
9282 }
9283
9284 sub process_bill_and_collect {
9285   my $job = shift;
9286   my $param = thaw(decode_base64(shift));
9287   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
9288       or die "custnum '$param->{custnum}' not found!\n";
9289   $param->{'job'}   = $job;
9290   $param->{'fatal'} = 1; # runs from job queue, will be caught
9291   $param->{'retry'} = 1;
9292
9293   $cust_main->bill_and_collect( %$param );
9294 }
9295
9296 sub _upgrade_data { #class method
9297   my ($class, %opts) = @_;
9298
9299   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
9300   my $sth = dbh->prepare($sql) or die dbh->errstr;
9301   $sth->execute or die $sth->errstr;
9302
9303   local($ignore_expired_card) = 1;
9304   local($skip_fuzzyfiles) = 1;
9305   $class->_upgrade_otaker(%opts);
9306
9307 }
9308
9309 =back
9310
9311 =head1 BUGS
9312
9313 The delete method.
9314
9315 The delete method should possibly take an FS::cust_main object reference
9316 instead of a scalar customer number.
9317
9318 Bill and collect options should probably be passed as references instead of a
9319 list.
9320
9321 There should probably be a configuration file with a list of allowed credit
9322 card types.
9323
9324 No multiple currency support (probably a larger project than just this module).
9325
9326 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
9327
9328 Birthdates rely on negative epoch values.
9329
9330 The payby for card/check batches is broken.  With mixed batching, bad
9331 things will happen.
9332
9333 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
9334
9335 =head1 SEE ALSO
9336
9337 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
9338 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
9339 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
9340
9341 =cut
9342
9343 1;
9344