FS/FS/cust_main.pm

   1 package FS::cust_main;
   2
   3 require 5.006;
   4 use strict;
   5 use base qw( FS::cust_main::Billing FS::cust_main::Billing_Realtime
   6              FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin
   7              FS::Record
   8            );
   9 use vars qw( $DEBUG $me $conf
  10              @encrypted_fields
  11              $import
  12              $ignore_expired_card $ignore_illegal_zip $ignore_banned_card
  13              $skip_fuzzyfiles @fuzzyfields
  14              @paytypes
  15            );
  16 use Carp;
  17 use Scalar::Util qw( blessed );
  18 use List::Util qw( min );
  19 use Time::Local qw(timelocal);
  20 use Storable qw(thaw);
  21 use MIME::Base64;
  22 use Data::Dumper;
  23 use Tie::IxHash;
  24 use Digest::MD5 qw(md5_base64);
  25 use Date::Format;
  26 #use Date::Manip;
  27 use File::Temp qw( tempfile );
  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::CurrentUser;
  35 use FS::payby;
  36 use FS::cust_pkg;
  37 use FS::cust_svc;
  38 use FS::cust_bill;
  39 use FS::cust_pay;
  40 use FS::cust_pay_pending;
  41 use FS::cust_pay_void;
  42 use FS::cust_pay_batch;
  43 use FS::cust_credit;
  44 use FS::cust_refund;
  45 use FS::part_referral;
  46 use FS::cust_main_county;
  47 use FS::cust_location;
  48 use FS::cust_class;
  49 use FS::cust_main_exemption;
  50 use FS::cust_tax_adjustment;
  51 use FS::cust_tax_location;
  52 use FS::agent;
  53 use FS::cust_main_invoice;
  54 use FS::cust_tag;
  55 use FS::prepay_credit;
  56 use FS::queue;
  57 use FS::part_pkg;
  58 use FS::part_export;
  59 #use FS::cust_event;
  60 use FS::type_pkgs;
  61 use FS::payment_gateway;
  62 use FS::agent_payment_gateway;
  63 use FS::banned_pay;
  64 use FS::TicketSystem;
  65
  66 # 1 is mostly method/subroutine entry and options
  67 # 2 traces progress of some operations
  68 # 3 is even more information including possibly sensitive data
  69 $DEBUG = 0;
  70 $me = '[FS::cust_main]';
  71
  72 $import = 0;
  73 $ignore_expired_card = 0;
  74 $ignore_illegal_zip = 0;
  75 $ignore_banned_card = 0;
  76
  77 $skip_fuzzyfiles = 0;
  78 @fuzzyfields = ( 'first', 'last', 'company', 'address1' );
  79
  80 @encrypted_fields = ('payinfo', 'paycvv');
  81 sub nohistory_fields { ('payinfo', 'paycvv'); }
  82
  83 @paytypes = ('', 'Personal checking', 'Personal savings', 'Business checking', 'Business savings');
  84
  85 #ask FS::UID to run this stuff for us later
  86 #$FS::UID::callback{'FS::cust_main'} = sub {
  87 install_callback FS::UID sub {
  88   $conf = new FS::Conf;
  89   #yes, need it for stuff below (prolly should be cached)
  90 };
  91
  92 sub _cache {
  93   my $self = shift;
  94   my ( $hashref, $cache ) = @_;
  95   if ( exists $hashref->{'pkgnum'} ) {
  96     #@{ $self->{'_pkgnum'} } = ();
  97     my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum});
  98     $self->{'_pkgnum'} = $subcache;
  99     #push @{ $self->{'_pkgnum'} },
 100     FS::cust_pkg->new_or_cached($hashref, $subcache) if $hashref->{pkgnum};
 101   }
 102 }
 103
 104 =head1 NAME
 105
 106 FS::cust_main - Object methods for cust_main records
 107
 108 =head1 SYNOPSIS
 109
 110   use FS::cust_main;
 111
 112   $record = new FS::cust_main \%hash;
 113   $record = new FS::cust_main { 'column' => 'value' };
 114
 115   $error = $record->insert;
 116
 117   $error = $new_record->replace($old_record);
 118
 119   $error = $record->delete;
 120
 121   $error = $record->check;
 122
 123   @cust_pkg = $record->all_pkgs;
 124
 125   @cust_pkg = $record->ncancelled_pkgs;
 126
 127   @cust_pkg = $record->suspended_pkgs;
 128
 129   $error = $record->bill;
 130   $error = $record->bill %options;
 131   $error = $record->bill 'time' => $time;
 132
 133   $error = $record->collect;
 134   $error = $record->collect %options;
 135   $error = $record->collect 'invoice_time'   => $time,
 136                           ;
 137
 138 =head1 DESCRIPTION
 139
 140 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 141 FS::Record.  The following fields are currently supported:
 142
 143 =over 4
 144
 145 =item custnum
 146
 147 Primary key (assigned automatically for new customers)
 148
 149 =item agentnum
 150
 151 Agent (see L<FS::agent>)
 152
 153 =item refnum
 154
 155 Advertising source (see L<FS::part_referral>)
 156
 157 =item first
 158
 159 First name
 160
 161 =item last
 162
 163 Last name
 164
 165 =item ss
 166
 167 Cocial security number (optional)
 168
 169 =item company
 170
 171 (optional)
 172
 173 =item address1
 174
 175 =item address2
 176
 177 (optional)
 178
 179 =item city
 180
 181 =item county
 182
 183 (optional, see L<FS::cust_main_county>)
 184
 185 =item state
 186
 187 (see L<FS::cust_main_county>)
 188
 189 =item zip
 190
 191 =item country
 192
 193 (see L<FS::cust_main_county>)
 194
 195 =item daytime
 196
 197 phone (optional)
 198
 199 =item night
 200
 201 phone (optional)
 202
 203 =item fax
 204
 205 phone (optional)
 206
 207 =item ship_first
 208
 209 Shipping first name
 210
 211 =item ship_last
 212
 213 Shipping last name
 214
 215 =item ship_company
 216
 217 (optional)
 218
 219 =item ship_address1
 220
 221 =item ship_address2
 222
 223 (optional)
 224
 225 =item ship_city
 226
 227 =item ship_county
 228
 229 (optional, see L<FS::cust_main_county>)
 230
 231 =item ship_state
 232
 233 (see L<FS::cust_main_county>)
 234
 235 =item ship_zip
 236
 237 =item ship_country
 238
 239 (see L<FS::cust_main_county>)
 240
 241 =item ship_daytime
 242
 243 phone (optional)
 244
 245 =item ship_night
 246
 247 phone (optional)
 248
 249 =item ship_fax
 250
 251 phone (optional)
 252
 253 =item payby
 254
 255 Payment Type (See L<FS::payinfo_Mixin> for valid payby values)
 256
 257 =item payinfo
 258
 259 Payment Information (See L<FS::payinfo_Mixin> for data format)
 260
 261 =item paymask
 262
 263 Masked payinfo (See L<FS::payinfo_Mixin> for how this works)
 264
 265 =item paycvv
 266
 267 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
 268
 269 =item paydate
 270
 271 Expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 272
 273 =item paystart_month
 274
 275 Start date month (maestro/solo cards only)
 276
 277 =item paystart_year
 278
 279 Start date year (maestro/solo cards only)
 280
 281 =item payissue
 282
 283 Issue number (maestro/solo cards only)
 284
 285 =item payname
 286
 287 Name on card or billing name
 288
 289 =item payip
 290
 291 IP address from which payment information was received
 292
 293 =item tax
 294
 295 Tax exempt, empty or `Y'
 296
 297 =item usernum
 298
 299 Order taker (see L<FS::access_user>)
 300
 301 =item comments
 302
 303 Comments (optional)
 304
 305 =item referral_custnum
 306
 307 Referring customer number
 308
 309 =item spool_cdr
 310
 311 Enable individual CDR spooling, empty or `Y'
 312
 313 =item dundate
 314
 315 A suggestion to events (see L<FS::part_bill_event">) to delay until this unix timestamp
 316
 317 =item squelch_cdr
 318
 319 Discourage individual CDR printing, empty or `Y'
 320
 321 =back
 322
 323 =head1 METHODS
 324
 325 =over 4
 326
 327 =item new HASHREF
 328
 329 Creates a new customer.  To add the customer to the database, see L<"insert">.
 330
 331 Note that this stores the hash reference, not a distinct copy of the hash it
 332 points to.  You can ask the object for a copy with the I<hash> method.
 333
 334 =cut
 335
 336 sub table { 'cust_main'; }
 337
 338 =item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
 339
 340 Adds this customer to the database.  If there is an error, returns the error,
 341 otherwise returns false.
 342
 343 CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert
 344 method containing FS::cust_pkg and FS::svc_I<tablename> objects, all records
 345 are inserted atomicly, or the transaction is rolled back.  Passing an empty
 346 hash reference is equivalent to not supplying this parameter.  There should be
 347 a better explanation of this, but until then, here's an example:
 348
 349   use Tie::RefHash;
 350   tie %hash, 'Tie::RefHash'; #this part is important
 351   %hash = (
 352     $cust_pkg => [ $svc_acct ],
 353     ...
 354   );
 355   $cust_main->insert( \%hash );
 356
 357 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
 358 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
 359 expected and rollback the entire transaction; it is not necessary to call
 360 check_invoicing_list first.  The invoicing_list is set after the records in the
 361 CUST_PKG_HASHREF above are inserted, so it is now possible to set an
 362 invoicing_list destination to the newly-created svc_acct.  Here's an example:
 363
 364   $cust_main->insert( {}, [ $email, 'POST' ] );
 365
 366 Currently available options are: I<depend_jobnum>, I<noexport> and I<tax_exemption>.
 367
 368 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 369 on the supplied jobnum (they will not run until the specific job completes).
 370 This can be used to defer provisioning until some action completes (such
 371 as running the customer's credit card successfully).
 372
 373 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 374 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 375 the B<reexport> method.)
 376
 377 The I<tax_exemption> option can be set to an arrayref of tax names.
 378 FS::cust_main_exemption records will be created and inserted.
 379
 380 =cut
 381
 382 sub insert {
 383   my $self = shift;
 384   my $cust_pkgs = @_ ? shift : {};
 385   my $invoicing_list = @_ ? shift : '';
 386   my %options = @_;
 387   warn "$me insert called with options ".
 388        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 389     if $DEBUG;
 390
 391   local $SIG{HUP} = 'IGNORE';
 392   local $SIG{INT} = 'IGNORE';
 393   local $SIG{QUIT} = 'IGNORE';
 394   local $SIG{TERM} = 'IGNORE';
 395   local $SIG{TSTP} = 'IGNORE';
 396   local $SIG{PIPE} = 'IGNORE';
 397
 398   my $oldAutoCommit = $FS::UID::AutoCommit;
 399   local $FS::UID::AutoCommit = 0;
 400   my $dbh = dbh;
 401
 402   my $prepay_identifier = '';
 403   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes ) = (0, 0, 0, 0, 0);
 404   my $payby = '';
 405   if ( $self->payby eq 'PREPAY' ) {
 406
 407     $self->payby('BILL');
 408     $prepay_identifier = $self->payinfo;
 409     $self->payinfo('');
 410
 411     warn "  looking up prepaid card $prepay_identifier\n"
 412       if $DEBUG > 1;
 413
 414     my $error = $self->get_prepay( $prepay_identifier,
 415                                    'amount_ref'     => \$amount,
 416                                    'seconds_ref'    => \$seconds,
 417                                    'upbytes_ref'    => \$upbytes,
 418                                    'downbytes_ref'  => \$downbytes,
 419                                    'totalbytes_ref' => \$totalbytes,
 420                                  );
 421     if ( $error ) {
 422       $dbh->rollback if $oldAutoCommit;
 423       #return "error applying prepaid card (transaction rolled back): $error";
 424       return $error;
 425     }
 426
 427     $payby = 'PREP' if $amount;
 428
 429   } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) {
 430
 431     $payby = $1;
 432     $self->payby('BILL');
 433     $amount = $self->paid;
 434
 435   }
 436
 437   warn "  inserting $self\n"
 438     if $DEBUG > 1;
 439
 440   $self->signupdate(time) unless $self->signupdate;
 441
 442   $self->auto_agent_custid()
 443     if $conf->config('cust_main-auto_agent_custid') && ! $self->agent_custid;
 444
 445   my $error = $self->SUPER::insert;
 446   if ( $error ) {
 447     $dbh->rollback if $oldAutoCommit;
 448     #return "inserting cust_main record (transaction rolled back): $error";
 449     return $error;
 450   }
 451
 452   warn "  setting invoicing list\n"
 453     if $DEBUG > 1;
 454
 455   if ( $invoicing_list ) {
 456     $error = $self->check_invoicing_list( $invoicing_list );
 457     if ( $error ) {
 458       $dbh->rollback if $oldAutoCommit;
 459       #return "checking invoicing_list (transaction rolled back): $error";
 460       return $error;
 461     }
 462     $self->invoicing_list( $invoicing_list );
 463   }
 464
 465   warn "  setting customer tags\n"
 466     if $DEBUG > 1;
 467
 468   foreach my $tagnum ( @{ $self->tagnum || [] } ) {
 469     my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
 470                                       'custnum' => $self->custnum };
 471     my $error = $cust_tag->insert;
 472     if ( $error ) {
 473       $dbh->rollback if $oldAutoCommit;
 474       return $error;
 475     }
 476   }
 477
 478   if ( $invoicing_list ) {
 479     $error = $self->check_invoicing_list( $invoicing_list );
 480     if ( $error ) {
 481       $dbh->rollback if $oldAutoCommit;
 482       #return "checking invoicing_list (transaction rolled back): $error";
 483       return $error;
 484     }
 485     $self->invoicing_list( $invoicing_list );
 486   }
 487
 488
 489   warn "  setting cust_main_exemption\n"
 490     if $DEBUG > 1;
 491
 492   my $tax_exemption = delete $options{'tax_exemption'};
 493   if ( $tax_exemption ) {
 494     foreach my $taxname ( @$tax_exemption ) {
 495       my $cust_main_exemption = new FS::cust_main_exemption {
 496         'custnum' => $self->custnum,
 497         'taxname' => $taxname,
 498       };
 499       my $error = $cust_main_exemption->insert;
 500       if ( $error ) {
 501         $dbh->rollback if $oldAutoCommit;
 502         return "inserting cust_main_exemption (transaction rolled back): $error";
 503       }
 504     }
 505   }
 506
 507   if (    $conf->config('cust_main-skeleton_tables')
 508        && $conf->config('cust_main-skeleton_custnum') ) {
 509
 510     warn "  inserting skeleton records\n"
 511       if $DEBUG > 1;
 512
 513     my $error = $self->start_copy_skel;
 514     if ( $error ) {
 515       $dbh->rollback if $oldAutoCommit;
 516       return $error;
 517     }
 518
 519   }
 520
 521   warn "  ordering packages\n"
 522     if $DEBUG > 1;
 523
 524   $error = $self->order_pkgs( $cust_pkgs,
 525                               %options,
 526                               'seconds_ref'    => \$seconds,
 527                               'upbytes_ref'    => \$upbytes,
 528                               'downbytes_ref'  => \$downbytes,
 529                               'totalbytes_ref' => \$totalbytes,
 530                             );
 531   if ( $error ) {
 532     $dbh->rollback if $oldAutoCommit;
 533     return $error;
 534   }
 535
 536   if ( $seconds ) {
 537     $dbh->rollback if $oldAutoCommit;
 538     return "No svc_acct record to apply pre-paid time";
 539   }
 540   if ( $upbytes || $downbytes || $totalbytes ) {
 541     $dbh->rollback if $oldAutoCommit;
 542     return "No svc_acct record to apply pre-paid data";
 543   }
 544
 545   if ( $amount ) {
 546     warn "  inserting initial $payby payment of $amount\n"
 547       if $DEBUG > 1;
 548     $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier);
 549     if ( $error ) {
 550       $dbh->rollback if $oldAutoCommit;
 551       return "inserting payment (transaction rolled back): $error";
 552     }
 553   }
 554
 555   unless ( $import || $skip_fuzzyfiles ) {
 556     warn "  queueing fuzzyfiles update\n"
 557       if $DEBUG > 1;
 558     $error = $self->queue_fuzzyfiles_update;
 559     if ( $error ) {
 560       $dbh->rollback if $oldAutoCommit;
 561       return "updating fuzzy search cache: $error";
 562     }
 563   }
 564
 565   # cust_main exports!
 566   warn "  exporting\n" if $DEBUG > 1;
 567
 568   my $export_args = $options{'export_args'} || [];
 569
 570   my @part_export =
 571     map qsearch( 'part_export', {exportnum=>$_} ),
 572       $conf->config('cust_main-exports'); #, $agentnum
 573
 574   foreach my $part_export ( @part_export ) {
 575     my $error = $part_export->export_insert($self, @$export_args);
 576     if ( $error ) {
 577       $dbh->rollback if $oldAutoCommit;
 578       return "exporting to ". $part_export->exporttype.
 579              " (transaction rolled back): $error";
 580     }
 581   }
 582
 583   #foreach my $depend_jobnum ( @$depend_jobnums ) {
 584   #    warn "[$me] inserting dependancies on supplied job $depend_jobnum\n"
 585   #      if $DEBUG;
 586   #    foreach my $jobnum ( @jobnums ) {
 587   #      my $queue = qsearchs('queue', { 'jobnum' => $jobnum } );
 588   #      warn "[$me] inserting dependancy for job $jobnum on $depend_jobnum\n"
 589   #        if $DEBUG;
 590   #      my $error = $queue->depend_insert($depend_jobnum);
 591   #      if ( $error ) {
 592   #        $dbh->rollback if $oldAutoCommit;
 593   #        return "error queuing job dependancy: $error";
 594   #      }
 595   #    }
 596   #  }
 597   #
 598   #}
 599   #
 600   #if ( exists $options{'jobnums'} ) {
 601   #  push @{ $options{'jobnums'} }, @jobnums;
 602   #}
 603
 604   warn "  insert complete; committing transaction\n"
 605     if $DEBUG > 1;
 606
 607   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 608   '';
 609
 610 }
 611
 612 use File::CounterFile;
 613 sub auto_agent_custid {
 614   my $self = shift;
 615
 616   my $format = $conf->config('cust_main-auto_agent_custid');
 617   my $agent_custid;
 618   if ( $format eq '1YMMXXXXXXXX' ) {
 619
 620     my $counter = new File::CounterFile 'cust_main.agent_custid';
 621     $counter->lock;
 622
 623     my $ym = 100000000000 + time2str('%y%m00000000', time);
 624     if ( $ym > $counter->value ) {
 625       $counter->{'value'} = $agent_custid = $ym;
 626       $counter->{'updated'} = 1;
 627     } else {
 628       $agent_custid = $counter->inc;
 629     }
 630
 631     $counter->unlock;
 632
 633   } else {
 634     die "Unknown cust_main-auto_agent_custid format: $format";
 635   }
 636
 637   $self->agent_custid($agent_custid);
 638
 639 }
 640
 641 sub start_copy_skel {
 642   my $self = shift;
 643
 644   #'mg_user_preference' => {},
 645   #'mg_user_indicator_profile.user_indicator_profile_id' => { 'mg_profile_indicator.profile_indicator_id' => { 'mg_profile_details.profile_detail_id' }, },
 646   #'mg_watchlist_header.watchlist_header_id' => { 'mg_watchlist_details.watchlist_details_id' },
 647   #'mg_user_grid_header.grid_header_id' => { 'mg_user_grid_details.user_grid_details_id' },
 648   #'mg_portfolio_header.portfolio_header_id' => { 'mg_portfolio_trades.portfolio_trades_id' => { 'mg_portfolio_trades_positions.portfolio_trades_positions_id' } },
 649   my @tables = eval(join('\n',$conf->config('cust_main-skeleton_tables')));
 650   die $@ if $@;
 651
 652   _copy_skel( 'cust_main',                                 #tablename
 653               $conf->config('cust_main-skeleton_custnum'), #sourceid
 654               $self->custnum,                              #destid
 655               @tables,                                     #child tables
 656             );
 657 }
 658
 659 #recursive subroutine, not a method
 660 sub _copy_skel {
 661   my( $table, $sourceid, $destid, %child_tables ) = @_;
 662
 663   my $primary_key;
 664   if ( $table =~ /^(\w+)\.(\w+)$/ ) {
 665     ( $table, $primary_key ) = ( $1, $2 );
 666   } else {
 667     my $dbdef_table = dbdef->table($table);
 668     $primary_key = $dbdef_table->primary_key
 669       or return "$table has no primary key".
 670                 " (or do you need to run dbdef-create?)";
 671   }
 672
 673   warn "  _copy_skel: $table.$primary_key $sourceid to $destid for ".
 674        join (', ', keys %child_tables). "\n"
 675     if $DEBUG > 2;
 676
 677   foreach my $child_table_def ( keys %child_tables ) {
 678
 679     my $child_table;
 680     my $child_pkey = '';
 681     if ( $child_table_def =~ /^(\w+)\.(\w+)$/ ) {
 682       ( $child_table, $child_pkey ) = ( $1, $2 );
 683     } else {
 684       $child_table = $child_table_def;
 685
 686       $child_pkey = dbdef->table($child_table)->primary_key;
 687       #  or return "$table has no primary key".
 688       #            " (or do you need to run dbdef-create?)\n";
 689     }
 690
 691     my $sequence = '';
 692     if ( keys %{ $child_tables{$child_table_def} } ) {
 693
 694       return "$child_table has no primary key".
 695              " (run dbdef-create or try specifying it?)\n"
 696         unless $child_pkey;
 697
 698       #false laziness w/Record::insert and only works on Pg
 699       #refactor the proper last-inserted-id stuff out of Record::insert if this
 700       # ever gets use for anything besides a quick kludge for one customer
 701       my $default = dbdef->table($child_table)->column($child_pkey)->default;
 702       $default =~ /^nextval\(\(?'"?([\w\.]+)"?'/i
 703         or return "can't parse $child_table.$child_pkey default value ".
 704                   " for sequence name: $default";
 705       $sequence = $1;
 706
 707     }
 708
 709     my @sel_columns = grep { $_ ne $primary_key }
 710                            dbdef->table($child_table)->columns;
 711     my $sel_columns = join(', ', @sel_columns );
 712
 713     my @ins_columns = grep { $_ ne $child_pkey } @sel_columns;
 714     my $ins_columns = ' ( '. join(', ', $primary_key, @ins_columns ). ' ) ';
 715     my $placeholders = ' ( ?, '. join(', ', map '?', @ins_columns ). ' ) ';
 716
 717     my $sel_st = "SELECT $sel_columns FROM $child_table".
 718                  " WHERE $primary_key = $sourceid";
 719     warn "    $sel_st\n"
 720       if $DEBUG > 2;
 721     my $sel_sth = dbh->prepare( $sel_st )
 722       or return dbh->errstr;
 723
 724     $sel_sth->execute or return $sel_sth->errstr;
 725
 726     while ( my $row = $sel_sth->fetchrow_hashref ) {
 727
 728       warn "    selected row: ".
 729            join(', ', map { "$_=".$row->{$_} } keys %$row ). "\n"
 730         if $DEBUG > 2;
 731
 732       my $statement =
 733         "INSERT INTO $child_table $ins_columns VALUES $placeholders";
 734       my $ins_sth =dbh->prepare($statement)
 735           or return dbh->errstr;
 736       my @param = ( $destid, map $row->{$_}, @ins_columns );
 737       warn "    $statement: [ ". join(', ', @param). " ]\n"
 738         if $DEBUG > 2;
 739       $ins_sth->execute( @param )
 740         or return $ins_sth->errstr;
 741
 742       #next unless keys %{ $child_tables{$child_table} };
 743       next unless $sequence;
 744
 745       #another section of that laziness
 746       my $seq_sql = "SELECT currval('$sequence')";
 747       my $seq_sth = dbh->prepare($seq_sql) or return dbh->errstr;
 748       $seq_sth->execute or return $seq_sth->errstr;
 749       my $insertid = $seq_sth->fetchrow_arrayref->[0];
 750
 751       # don't drink soap!  recurse!  recurse!  okay!
 752       my $error =
 753         _copy_skel( $child_table_def,
 754                     $row->{$child_pkey}, #sourceid
 755                     $insertid, #destid
 756                     %{ $child_tables{$child_table_def} },
 757                   );
 758       return $error if $error;
 759
 760     }
 761
 762   }
 763
 764   return '';
 765
 766 }
 767
 768 =item order_pkg HASHREF | OPTION => VALUE ...
 769
 770 Orders a single package.
 771
 772 Options may be passed as a list of key/value pairs or as a hash reference.
 773 Options are:
 774
 775 =over 4
 776
 777 =item cust_pkg
 778
 779 FS::cust_pkg object
 780
 781 =item cust_location
 782
 783 Optional FS::cust_location object
 784
 785 =item svcs
 786
 787 Optional arryaref of FS::svc_* service objects.
 788
 789 =item depend_jobnum
 790
 791 If this option is set to a job queue jobnum (see L<FS::queue>), all provisioning
 792 jobs will have a dependancy on the supplied job (they will not run until the
 793 specific job completes).  This can be used to defer provisioning until some
 794 action completes (such as running the customer's credit card successfully).
 795
 796 =item ticket_subject
 797
 798 Optional subject for a ticket created and attached to this customer
 799
 800 =item ticket_subject
 801
 802 Optional queue name for ticket additions
 803
 804 =back
 805
 806 =cut
 807
 808 sub order_pkg {
 809   my $self = shift;
 810   my $opt = ref($_[0]) ? shift : { @_ };
 811
 812   warn "$me order_pkg called with options ".
 813        join(', ', map { "$_: $opt->{$_}" } keys %$opt ). "\n"
 814     if $DEBUG;
 815
 816   my $cust_pkg = $opt->{'cust_pkg'};
 817   my $svcs     = $opt->{'svcs'} || [];
 818
 819   my %svc_options = ();
 820   $svc_options{'depend_jobnum'} = $opt->{'depend_jobnum'}
 821     if exists($opt->{'depend_jobnum'}) && $opt->{'depend_jobnum'};
 822
 823   my %insert_params = map { $opt->{$_} ? ( $_ => $opt->{$_} ) : () }
 824                           qw( ticket_subject ticket_queue );
 825
 826   local $SIG{HUP} = 'IGNORE';
 827   local $SIG{INT} = 'IGNORE';
 828   local $SIG{QUIT} = 'IGNORE';
 829   local $SIG{TERM} = 'IGNORE';
 830   local $SIG{TSTP} = 'IGNORE';
 831   local $SIG{PIPE} = 'IGNORE';
 832
 833   my $oldAutoCommit = $FS::UID::AutoCommit;
 834   local $FS::UID::AutoCommit = 0;
 835   my $dbh = dbh;
 836
 837   if ( $opt->{'cust_location'} &&
 838        ( ! $cust_pkg->locationnum || $cust_pkg->locationnum == -1 ) ) {
 839     my $error = $opt->{'cust_location'}->insert;
 840     if ( $error ) {
 841       $dbh->rollback if $oldAutoCommit;
 842       return "inserting cust_location (transaction rolled back): $error";
 843     }
 844     $cust_pkg->locationnum($opt->{'cust_location'}->locationnum);
 845   }
 846
 847   $cust_pkg->custnum( $self->custnum );
 848
 849   my $error = $cust_pkg->insert( %insert_params );
 850   if ( $error ) {
 851     $dbh->rollback if $oldAutoCommit;
 852     return "inserting cust_pkg (transaction rolled back): $error";
 853   }
 854
 855   foreach my $svc_something ( @{ $opt->{'svcs'} } ) {
 856     if ( $svc_something->svcnum ) {
 857       my $old_cust_svc = $svc_something->cust_svc;
 858       my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash };
 859       $new_cust_svc->pkgnum( $cust_pkg->pkgnum);
 860       $error = $new_cust_svc->replace($old_cust_svc);
 861     } else {
 862       $svc_something->pkgnum( $cust_pkg->pkgnum );
 863       if ( $svc_something->isa('FS::svc_acct') ) {
 864         foreach ( grep { $opt->{$_.'_ref'} && ${ $opt->{$_.'_ref'} } }
 865                        qw( seconds upbytes downbytes totalbytes )      ) {
 866           $svc_something->$_( $svc_something->$_() + ${ $opt->{$_.'_ref'} } );
 867           ${ $opt->{$_.'_ref'} } = 0;
 868         }
 869       }
 870       $error = $svc_something->insert(%svc_options);
 871     }
 872     if ( $error ) {
 873       $dbh->rollback if $oldAutoCommit;
 874       return "inserting svc_ (transaction rolled back): $error";
 875     }
 876   }
 877
 878   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 879   ''; #no error
 880
 881 }
 882
 883 #deprecated #=item order_pkgs HASHREF [ , SECONDSREF ] [ , OPTION => VALUE ... ]
 884 =item order_pkgs HASHREF [ , OPTION => VALUE ... ]
 885
 886 Like the insert method on an existing record, this method orders multiple
 887 packages and included services atomicaly.  Pass a Tie::RefHash data structure
 888 to this method containing FS::cust_pkg and FS::svc_I<tablename> objects.
 889 There should be a better explanation of this, but until then, here's an
 890 example:
 891
 892   use Tie::RefHash;
 893   tie %hash, 'Tie::RefHash'; #this part is important
 894   %hash = (
 895     $cust_pkg => [ $svc_acct ],
 896     ...
 897   );
 898   $cust_main->order_pkgs( \%hash, 'noexport'=>1 );
 899
 900 Services can be new, in which case they are inserted, or existing unaudited
 901 services, in which case they are linked to the newly-created package.
 902
 903 Currently available options are: I<depend_jobnum>, I<noexport>, I<seconds_ref>,
 904 I<upbytes_ref>, I<downbytes_ref>, and I<totalbytes_ref>.
 905
 906 If I<depend_jobnum> is set, all provisioning jobs will have a dependancy
 907 on the supplied jobnum (they will not run until the specific job completes).
 908 This can be used to defer provisioning until some action completes (such
 909 as running the customer's credit card successfully).
 910
 911 The I<noexport> option is deprecated.  If I<noexport> is set true, no
 912 provisioning jobs (exports) are scheduled.  (You can schedule them later with
 913 the B<reexport> method for each cust_pkg object.  Using the B<reexport> method
 914 on the cust_main object is not recommended, as existing services will also be
 915 reexported.)
 916
 917 If I<seconds_ref>, I<upbytes_ref>, I<downbytes_ref>, or I<totalbytes_ref> is
 918 provided, the scalars (provided by references) will be incremented by the
 919 values of the prepaid card.`
 920
 921 =cut
 922
 923 sub order_pkgs {
 924   my $self = shift;
 925   my $cust_pkgs = shift;
 926   my $seconds_ref = ref($_[0]) ? shift : ''; #deprecated
 927   my %options = @_;
 928   $seconds_ref ||= $options{'seconds_ref'};
 929
 930   warn "$me order_pkgs called with options ".
 931        join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
 932     if $DEBUG;
 933
 934   local $SIG{HUP} = 'IGNORE';
 935   local $SIG{INT} = 'IGNORE';
 936   local $SIG{QUIT} = 'IGNORE';
 937   local $SIG{TERM} = 'IGNORE';
 938   local $SIG{TSTP} = 'IGNORE';
 939   local $SIG{PIPE} = 'IGNORE';
 940
 941   my $oldAutoCommit = $FS::UID::AutoCommit;
 942   local $FS::UID::AutoCommit = 0;
 943   my $dbh = dbh;
 944
 945   local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'};
 946
 947   foreach my $cust_pkg ( keys %$cust_pkgs ) {
 948
 949     my $error = $self->order_pkg(
 950       'cust_pkg'     => $cust_pkg,
 951       'svcs'         => $cust_pkgs->{$cust_pkg},
 952       'seconds_ref'  => $seconds_ref,
 953       map { $_ => $options{$_} } qw( upbytes_ref downbytes_ref totalbytes_ref
 954                                      depend_jobnum
 955                                    )
 956     );
 957     if ( $error ) {
 958       $dbh->rollback if $oldAutoCommit;
 959       return $error;
 960     }
 961
 962   }
 963
 964   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 965   ''; #no error
 966 }
 967
 968 =item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF, UPBYTEREF, DOWNBYTEREF ]
 969
 970 Recharges this (existing) customer with the specified prepaid card (see
 971 L<FS::prepay_credit>), specified either by I<identifier> or as an
 972 FS::prepay_credit object.  If there is an error, returns the error, otherwise
 973 returns false.
 974
 975 Optionally, five scalar references can be passed as well.  They will have their
 976 values filled in with the amount, number of seconds, and number of upload,
 977 download, and total bytes applied by this prepaid card.
 978
 979 =cut
 980
 981 #the ref bullshit here should be refactored like get_prepay.  MyAccount.pm is
 982 #the only place that uses these args
 983 sub recharge_prepay {
 984   my( $self, $prepay_credit, $amountref, $secondsref,
 985       $upbytesref, $downbytesref, $totalbytesref ) = @_;
 986
 987   local $SIG{HUP} = 'IGNORE';
 988   local $SIG{INT} = 'IGNORE';
 989   local $SIG{QUIT} = 'IGNORE';
 990   local $SIG{TERM} = 'IGNORE';
 991   local $SIG{TSTP} = 'IGNORE';
 992   local $SIG{PIPE} = 'IGNORE';
 993
 994   my $oldAutoCommit = $FS::UID::AutoCommit;
 995   local $FS::UID::AutoCommit = 0;
 996   my $dbh = dbh;
 997
 998   my( $amount, $seconds, $upbytes, $downbytes, $totalbytes) = ( 0, 0, 0, 0, 0 );
 999
1000   my $error = $self->get_prepay( $prepay_credit,
1001                                  'amount_ref'     => \$amount,
1002                                  'seconds_ref'    => \$seconds,
1003                                  'upbytes_ref'    => \$upbytes,
1004                                  'downbytes_ref'  => \$downbytes,
1005                                  'totalbytes_ref' => \$totalbytes,
1006                                )
1007            || $self->increment_seconds($seconds)
1008            || $self->increment_upbytes($upbytes)
1009            || $self->increment_downbytes($downbytes)
1010            || $self->increment_totalbytes($totalbytes)
1011            || $self->insert_cust_pay_prepay( $amount,
1012                                              ref($prepay_credit)
1013                                                ? $prepay_credit->identifier
1014                                                : $prepay_credit
1015                                            );
1016
1017   if ( $error ) {
1018     $dbh->rollback if $oldAutoCommit;
1019     return $error;
1020   }
1021
1022   if ( defined($amountref)  ) { $$amountref  = $amount;  }
1023   if ( defined($secondsref) ) { $$secondsref = $seconds; }
1024   if ( defined($upbytesref) ) { $$upbytesref = $upbytes; }
1025   if ( defined($downbytesref) ) { $$downbytesref = $downbytes; }
1026   if ( defined($totalbytesref) ) { $$totalbytesref = $totalbytes; }
1027
1028   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1029   '';
1030
1031 }
1032
1033 =item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , OPTION => VALUE ... ]
1034
1035 Looks up and deletes a prepaid card (see L<FS::prepay_credit>),
1036 specified either by I<identifier> or as an FS::prepay_credit object.
1037
1038 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
1039 incremented by the values of the prepaid card.
1040
1041 If the prepaid card specifies an I<agentnum> (see L<FS::agent>), it is used to
1042 check or set this customer's I<agentnum>.
1043
1044 If there is an error, returns the error, otherwise returns false.
1045
1046 =cut
1047
1048
1049 sub get_prepay {
1050   my( $self, $prepay_credit, %opt ) = @_;
1051
1052   local $SIG{HUP} = 'IGNORE';
1053   local $SIG{INT} = 'IGNORE';
1054   local $SIG{QUIT} = 'IGNORE';
1055   local $SIG{TERM} = 'IGNORE';
1056   local $SIG{TSTP} = 'IGNORE';
1057   local $SIG{PIPE} = 'IGNORE';
1058
1059   my $oldAutoCommit = $FS::UID::AutoCommit;
1060   local $FS::UID::AutoCommit = 0;
1061   my $dbh = dbh;
1062
1063   unless ( ref($prepay_credit) ) {
1064
1065     my $identifier = $prepay_credit;
1066
1067     $prepay_credit = qsearchs(
1068       'prepay_credit',
1069       { 'identifier' => $prepay_credit },
1070       '',
1071       'FOR UPDATE'
1072     );
1073
1074     unless ( $prepay_credit ) {
1075       $dbh->rollback if $oldAutoCommit;
1076       return "Invalid prepaid card: ". $identifier;
1077     }
1078
1079   }
1080
1081   if ( $prepay_credit->agentnum ) {
1082     if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) {
1083       $dbh->rollback if $oldAutoCommit;
1084       return "prepaid card not valid for agent ". $self->agentnum;
1085     }
1086     $self->agentnum($prepay_credit->agentnum);
1087   }
1088
1089   my $error = $prepay_credit->delete;
1090   if ( $error ) {
1091     $dbh->rollback if $oldAutoCommit;
1092     return "removing prepay_credit (transaction rolled back): $error";
1093   }
1094
1095   ${ $opt{$_.'_ref'} } += $prepay_credit->$_()
1096     for grep $opt{$_.'_ref'}, qw( amount seconds upbytes downbytes totalbytes );
1097
1098   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1099   '';
1100
1101 }
1102
1103 =item increment_upbytes SECONDS
1104
1105 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1106 the specified number of upbytes.  If there is an error, returns the error,
1107 otherwise returns false.
1108
1109 =cut
1110
1111 sub increment_upbytes {
1112   _increment_column( shift, 'upbytes', @_);
1113 }
1114
1115 =item increment_downbytes SECONDS
1116
1117 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1118 the specified number of downbytes.  If there is an error, returns the error,
1119 otherwise returns false.
1120
1121 =cut
1122
1123 sub increment_downbytes {
1124   _increment_column( shift, 'downbytes', @_);
1125 }
1126
1127 =item increment_totalbytes SECONDS
1128
1129 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1130 the specified number of totalbytes.  If there is an error, returns the error,
1131 otherwise returns false.
1132
1133 =cut
1134
1135 sub increment_totalbytes {
1136   _increment_column( shift, 'totalbytes', @_);
1137 }
1138
1139 =item increment_seconds SECONDS
1140
1141 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1142 the specified number of seconds.  If there is an error, returns the error,
1143 otherwise returns false.
1144
1145 =cut
1146
1147 sub increment_seconds {
1148   _increment_column( shift, 'seconds', @_);
1149 }
1150
1151 =item _increment_column AMOUNT
1152
1153 Updates this customer's single or primary account (see L<FS::svc_acct>) by
1154 the specified number of seconds or bytes.  If there is an error, returns
1155 the error, otherwise returns false.
1156
1157 =cut
1158
1159 sub _increment_column {
1160   my( $self, $column, $amount ) = @_;
1161   warn "$me increment_column called: $column, $amount\n"
1162     if $DEBUG;
1163
1164   return '' unless $amount;
1165
1166   my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') }
1167                       $self->ncancelled_pkgs;
1168
1169   if ( ! @cust_pkg ) {
1170     return 'No packages with primary or single services found'.
1171            ' to apply pre-paid time';
1172   } elsif ( scalar(@cust_pkg) > 1 ) {
1173     #maybe have a way to specify the package/account?
1174     return 'Multiple packages found to apply pre-paid time';
1175   }
1176
1177   my $cust_pkg = $cust_pkg[0];
1178   warn "  found package pkgnum ". $cust_pkg->pkgnum. "\n"
1179     if $DEBUG > 1;
1180
1181   my @cust_svc =
1182     $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') );
1183
1184   if ( ! @cust_svc ) {
1185     return 'No account found to apply pre-paid time';
1186   } elsif ( scalar(@cust_svc) > 1 ) {
1187     return 'Multiple accounts found to apply pre-paid time';
1188   }
1189
1190   my $svc_acct = $cust_svc[0]->svc_x;
1191   warn "  found service svcnum ". $svc_acct->pkgnum.
1192        ' ('. $svc_acct->email. ")\n"
1193     if $DEBUG > 1;
1194
1195   $column = "increment_$column";
1196   $svc_acct->$column($amount);
1197
1198 }
1199
1200 =item insert_cust_pay_prepay AMOUNT [ PAYINFO ]
1201
1202 Inserts a prepayment in the specified amount for this customer.  An optional
1203 second argument can specify the prepayment identifier for tracking purposes.
1204 If there is an error, returns the error, otherwise returns false.
1205
1206 =cut
1207
1208 sub insert_cust_pay_prepay {
1209   shift->insert_cust_pay('PREP', @_);
1210 }
1211
1212 =item insert_cust_pay_cash AMOUNT [ PAYINFO ]
1213
1214 Inserts a cash payment in the specified amount for this customer.  An optional
1215 second argument can specify the payment 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_cash {
1221   shift->insert_cust_pay('CASH', @_);
1222 }
1223
1224 =item insert_cust_pay_west AMOUNT [ PAYINFO ]
1225
1226 Inserts a Western Union payment in the specified amount for this customer.  An
1227 optional second argument can specify the prepayment identifier for tracking
1228 purposes.  If there is an error, returns the error, otherwise returns false.
1229
1230 =cut
1231
1232 sub insert_cust_pay_west {
1233   shift->insert_cust_pay('WEST', @_);
1234 }
1235
1236 sub insert_cust_pay {
1237   my( $self, $payby, $amount ) = splice(@_, 0, 3);
1238   my $payinfo = scalar(@_) ? shift : '';
1239
1240   my $cust_pay = new FS::cust_pay {
1241     'custnum' => $self->custnum,
1242     'paid'    => sprintf('%.2f', $amount),
1243     #'_date'   => #date the prepaid card was purchased???
1244     'payby'   => $payby,
1245     'payinfo' => $payinfo,
1246   };
1247   $cust_pay->insert;
1248
1249 }
1250
1251 =item reexport
1252
1253 This method is deprecated.  See the I<depend_jobnum> option to the insert and
1254 order_pkgs methods for a better way to defer provisioning.
1255
1256 Re-schedules all exports by calling the B<reexport> method of all associated
1257 packages (see L<FS::cust_pkg>).  If there is an error, returns the error;
1258 otherwise returns false.
1259
1260 =cut
1261
1262 sub reexport {
1263   my $self = shift;
1264
1265   carp "WARNING: FS::cust_main::reexport is deprectated; ".
1266        "use the depend_jobnum option to insert or order_pkgs to delay export";
1267
1268   local $SIG{HUP} = 'IGNORE';
1269   local $SIG{INT} = 'IGNORE';
1270   local $SIG{QUIT} = 'IGNORE';
1271   local $SIG{TERM} = 'IGNORE';
1272   local $SIG{TSTP} = 'IGNORE';
1273   local $SIG{PIPE} = 'IGNORE';
1274
1275   my $oldAutoCommit = $FS::UID::AutoCommit;
1276   local $FS::UID::AutoCommit = 0;
1277   my $dbh = dbh;
1278
1279   foreach my $cust_pkg ( $self->ncancelled_pkgs ) {
1280     my $error = $cust_pkg->reexport;
1281     if ( $error ) {
1282       $dbh->rollback if $oldAutoCommit;
1283       return $error;
1284     }
1285   }
1286
1287   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1288   '';
1289
1290 }
1291
1292 =item delete [ OPTION => VALUE ... ]
1293
1294 This deletes the customer.  If there is an error, returns the error, otherwise
1295 returns false.
1296
1297 This will completely remove all traces of the customer record.  This is not
1298 what you want when a customer cancels service; for that, cancel all of the
1299 customer's packages (see L</cancel>).
1300
1301 If the customer has any uncancelled packages, you need to pass a new (valid)
1302 customer number for those packages to be transferred to, as the "new_customer"
1303 option.  Cancelled packages will be deleted.  Did I mention that this is NOT
1304 what you want when a customer cancels service and that you really should be
1305 looking at L<FS::cust_pkg/cancel>?
1306
1307 You can't delete a customer with invoices (see L<FS::cust_bill>),
1308 statements (see L<FS::cust_statement>), credits (see L<FS::cust_credit>),
1309 payments (see L<FS::cust_pay>) or refunds (see L<FS::cust_refund>), unless you
1310 set the "delete_financials" option to a true value.
1311
1312 =cut
1313
1314 sub delete {
1315   my( $self, %opt ) = @_;
1316
1317   local $SIG{HUP} = 'IGNORE';
1318   local $SIG{INT} = 'IGNORE';
1319   local $SIG{QUIT} = 'IGNORE';
1320   local $SIG{TERM} = 'IGNORE';
1321   local $SIG{TSTP} = 'IGNORE';
1322   local $SIG{PIPE} = 'IGNORE';
1323
1324   my $oldAutoCommit = $FS::UID::AutoCommit;
1325   local $FS::UID::AutoCommit = 0;
1326   my $dbh = dbh;
1327
1328   if ( qsearch('agent', { 'agent_custnum' => $self->custnum } ) ) {
1329      $dbh->rollback if $oldAutoCommit;
1330      return "Can't delete a master agent customer";
1331   }
1332
1333   #use FS::access_user
1334   if ( qsearch('access_user', { 'user_custnum' => $self->custnum } ) ) {
1335      $dbh->rollback if $oldAutoCommit;
1336      return "Can't delete a master employee customer";
1337   }
1338
1339   tie my %financial_tables, 'Tie::IxHash',
1340     'cust_bill'      => 'invoices',
1341     'cust_statement' => 'statements',
1342     'cust_credit'    => 'credits',
1343     'cust_pay'       => 'payments',
1344     'cust_refund'    => 'refunds',
1345   ;
1346
1347   foreach my $table ( keys %financial_tables ) {
1348
1349     my @records = $self->$table();
1350
1351     if ( @records && ! $opt{'delete_financials'} ) {
1352       $dbh->rollback if $oldAutoCommit;
1353       return "Can't delete a customer with ". $financial_tables{$table};
1354     }
1355
1356     foreach my $record ( @records ) {
1357       my $error = $record->delete;
1358       if ( $error ) {
1359         $dbh->rollback if $oldAutoCommit;
1360         return "Error deleting ". $financial_tables{$table}. ": $error\n";
1361       }
1362     }
1363
1364   }
1365
1366   my @cust_pkg = $self->ncancelled_pkgs;
1367   if ( @cust_pkg ) {
1368     my $new_custnum = $opt{'new_custnum'};
1369     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
1370       $dbh->rollback if $oldAutoCommit;
1371       return "Invalid new customer number: $new_custnum";
1372     }
1373     foreach my $cust_pkg ( @cust_pkg ) {
1374       my %hash = $cust_pkg->hash;
1375       $hash{'custnum'} = $new_custnum;
1376       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
1377       my $error = $new_cust_pkg->replace($cust_pkg,
1378                                          options => { $cust_pkg->options },
1379                                         );
1380       if ( $error ) {
1381         $dbh->rollback if $oldAutoCommit;
1382         return $error;
1383       }
1384     }
1385   }
1386   my @cancelled_cust_pkg = $self->all_pkgs;
1387   foreach my $cust_pkg ( @cancelled_cust_pkg ) {
1388     my $error = $cust_pkg->delete;
1389     if ( $error ) {
1390       $dbh->rollback if $oldAutoCommit;
1391       return $error;
1392     }
1393   }
1394
1395   #cust_tax_adjustment in financials?
1396   #cust_pay_pending?  ouch
1397   #cust_recon?
1398   foreach my $table (qw(
1399     cust_main_invoice cust_main_exemption cust_tag cust_attachment contact
1400     cust_location cust_main_note cust_tax_adjustment
1401     cust_pay_void cust_pay_batch queue cust_tax_exempt
1402   )) {
1403     foreach my $record ( qsearch( $table, { 'custnum' => $self->custnum } ) ) {
1404       my $error = $record->delete;
1405       if ( $error ) {
1406         $dbh->rollback if $oldAutoCommit;
1407         return $error;
1408       }
1409     }
1410   }
1411
1412   my $sth = $dbh->prepare(
1413     'UPDATE cust_main SET referral_custnum = NULL WHERE referral_custnum = ?'
1414   ) or do {
1415     my $errstr = $dbh->errstr;
1416     $dbh->rollback if $oldAutoCommit;
1417     return $errstr;
1418   };
1419   $sth->execute($self->custnum) or do {
1420     my $errstr = $sth->errstr;
1421     $dbh->rollback if $oldAutoCommit;
1422     return $errstr;
1423   };
1424
1425   #tickets
1426
1427   my $ticket_dbh = '';
1428   if ($conf->config('ticket_system') eq 'RT_Internal') {
1429     $ticket_dbh = $dbh;
1430   } elsif ($conf->config('ticket_system') eq 'RT_External') {
1431     my ($datasrc, $user, $pass) = $conf->config('ticket_system-rt_external_datasrc');
1432     $ticket_dbh = DBI->connect($datasrc, $user, $pass, { 'ChopBlanks' => 1 });
1433       #or die "RT_External DBI->connect error: $DBI::errstr\n";
1434   }
1435
1436   if ( $ticket_dbh ) {
1437
1438     my $ticket_sth = $ticket_dbh->prepare(
1439       'DELETE FROM Links WHERE Target = ?'
1440     ) or do {
1441       my $errstr = $ticket_dbh->errstr;
1442       $dbh->rollback if $oldAutoCommit;
1443       return $errstr;
1444     };
1445     $ticket_sth->execute('freeside://freeside/cust_main/'.$self->custnum)
1446       or do {
1447         my $errstr = $ticket_sth->errstr;
1448         $dbh->rollback if $oldAutoCommit;
1449         return $errstr;
1450       };
1451
1452     #check and see if the customer is the only link on the ticket, and
1453     #if so, set the ticket to deleted status in RT?
1454     #maybe someday, for now this will at least fix tickets not displaying
1455
1456   }
1457
1458   #delete the customer record
1459
1460   my $error = $self->SUPER::delete;
1461   if ( $error ) {
1462     $dbh->rollback if $oldAutoCommit;
1463     return $error;
1464   }
1465
1466   # cust_main exports!
1467
1468   #my $export_args = $options{'export_args'} || [];
1469
1470   my @part_export =
1471     map qsearch( 'part_export', {exportnum=>$_} ),
1472       $conf->config('cust_main-exports'); #, $agentnum
1473
1474   foreach my $part_export ( @part_export ) {
1475     my $error = $part_export->export_delete( $self ); #, @$export_args);
1476     if ( $error ) {
1477       $dbh->rollback if $oldAutoCommit;
1478       return "exporting to ". $part_export->exporttype.
1479              " (transaction rolled back): $error";
1480     }
1481   }
1482
1483   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1484   '';
1485
1486 }
1487
1488 =item replace [ OLD_RECORD ] [ INVOICING_LIST_ARYREF ] [ , OPTION => VALUE ... ] ]
1489
1490
1491 Replaces the OLD_RECORD with this one in the database.  If there is an error,
1492 returns the error, otherwise returns false.
1493
1494 INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will
1495 be set as the invoicing list (see L<"invoicing_list">).  Errors return as
1496 expected and rollback the entire transaction; it is not necessary to call
1497 check_invoicing_list first.  Here's an example:
1498
1499   $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] );
1500
1501 Currently available options are: I<tax_exemption>.
1502
1503 The I<tax_exemption> option can be set to an arrayref of tax names.
1504 FS::cust_main_exemption records will be deleted and inserted as appropriate.
1505
1506 =cut
1507
1508 sub replace {
1509   my $self = shift;
1510
1511   my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
1512               ? shift
1513               : $self->replace_old;
1514
1515   my @param = @_;
1516
1517   warn "$me replace called\n"
1518     if $DEBUG;
1519
1520   my $curuser = $FS::CurrentUser::CurrentUser;
1521   if (    $self->payby eq 'COMP'
1522        && $self->payby ne $old->payby
1523        && ! $curuser->access_right('Complimentary customer')
1524      )
1525   {
1526     return "You are not permitted to create complimentary accounts.";
1527   }
1528
1529   local($ignore_expired_card) = 1
1530     if $old->payby  =~ /^(CARD|DCRD)$/
1531     && $self->payby =~ /^(CARD|DCRD)$/
1532     && ( $old->payinfo eq $self->payinfo || $old->paymask eq $self->paymask );
1533
1534   local $SIG{HUP} = 'IGNORE';
1535   local $SIG{INT} = 'IGNORE';
1536   local $SIG{QUIT} = 'IGNORE';
1537   local $SIG{TERM} = 'IGNORE';
1538   local $SIG{TSTP} = 'IGNORE';
1539   local $SIG{PIPE} = 'IGNORE';
1540
1541   my $oldAutoCommit = $FS::UID::AutoCommit;
1542   local $FS::UID::AutoCommit = 0;
1543   my $dbh = dbh;
1544
1545   my $error = $self->SUPER::replace($old);
1546
1547   if ( $error ) {
1548     $dbh->rollback if $oldAutoCommit;
1549     return $error;
1550   }
1551
1552   if ( @param && ref($param[0]) eq 'ARRAY' ) { # INVOICING_LIST_ARYREF
1553     my $invoicing_list = shift @param;
1554     $error = $self->check_invoicing_list( $invoicing_list );
1555     if ( $error ) {
1556       $dbh->rollback if $oldAutoCommit;
1557       return $error;
1558     }
1559     $self->invoicing_list( $invoicing_list );
1560   }
1561
1562   if ( $self->exists('tagnum') ) { #so we don't delete these on edit by accident
1563
1564     #this could be more efficient than deleting and re-inserting, if it matters
1565     foreach my $cust_tag (qsearch('cust_tag', {'custnum'=>$self->custnum} )) {
1566       my $error = $cust_tag->delete;
1567       if ( $error ) {
1568         $dbh->rollback if $oldAutoCommit;
1569         return $error;
1570       }
1571     }
1572     foreach my $tagnum ( @{ $self->tagnum || [] } ) {
1573       my $cust_tag = new FS::cust_tag { 'tagnum'  => $tagnum,
1574                                         'custnum' => $self->custnum };
1575       my $error = $cust_tag->insert;
1576       if ( $error ) {
1577         $dbh->rollback if $oldAutoCommit;
1578         return $error;
1579       }
1580     }
1581
1582   }
1583
1584   my %options = @param;
1585
1586   my $tax_exemption = delete $options{'tax_exemption'};
1587   if ( $tax_exemption ) {
1588
1589     my %cust_main_exemption =
1590       map { $_->taxname => $_ }
1591           qsearch('cust_main_exemption', { 'custnum' => $old->custnum } );
1592
1593     foreach my $taxname ( @$tax_exemption ) {
1594
1595       next if delete $cust_main_exemption{$taxname};
1596
1597       my $cust_main_exemption = new FS::cust_main_exemption {
1598         'custnum' => $self->custnum,
1599         'taxname' => $taxname,
1600       };
1601       my $error = $cust_main_exemption->insert;
1602       if ( $error ) {
1603         $dbh->rollback if $oldAutoCommit;
1604         return "inserting cust_main_exemption (transaction rolled back): $error";
1605       }
1606     }
1607
1608     foreach my $cust_main_exemption ( values %cust_main_exemption ) {
1609       my $error = $cust_main_exemption->delete;
1610       if ( $error ) {
1611         $dbh->rollback if $oldAutoCommit;
1612         return "deleting cust_main_exemption (transaction rolled back): $error";
1613       }
1614     }
1615
1616   }
1617
1618   if ( $self->payby =~ /^(CARD|CHEK|LECB)$/
1619        && ( ( $self->get('payinfo') ne $old->get('payinfo')
1620               && $self->get('payinfo') !~ /^99\d{14}$/
1621             )
1622             || grep { $self->get($_) ne $old->get($_) } qw(paydate payname)
1623           )
1624      )
1625   {
1626
1627     # card/check/lec info has changed, want to retry realtime_ invoice events
1628     my $error = $self->retry_realtime;
1629     if ( $error ) {
1630       $dbh->rollback if $oldAutoCommit;
1631       return $error;
1632     }
1633   }
1634
1635   unless ( $import || $skip_fuzzyfiles ) {
1636     $error = $self->queue_fuzzyfiles_update;
1637     if ( $error ) {
1638       $dbh->rollback if $oldAutoCommit;
1639       return "updating fuzzy search cache: $error";
1640     }
1641   }
1642
1643   # cust_main exports!
1644
1645   my $export_args = $options{'export_args'} || [];
1646
1647   my @part_export =
1648     map qsearch( 'part_export', {exportnum=>$_} ),
1649       $conf->config('cust_main-exports'); #, $agentnum
1650
1651   foreach my $part_export ( @part_export ) {
1652     my $error = $part_export->export_replace( $self, $old, @$export_args);
1653     if ( $error ) {
1654       $dbh->rollback if $oldAutoCommit;
1655       return "exporting to ". $part_export->exporttype.
1656              " (transaction rolled back): $error";
1657     }
1658   }
1659
1660   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1661   '';
1662
1663 }
1664
1665 =item queue_fuzzyfiles_update
1666
1667 Used by insert & replace to update the fuzzy search cache
1668
1669 =cut
1670
1671 sub queue_fuzzyfiles_update {
1672   my $self = shift;
1673
1674   local $SIG{HUP} = 'IGNORE';
1675   local $SIG{INT} = 'IGNORE';
1676   local $SIG{QUIT} = 'IGNORE';
1677   local $SIG{TERM} = 'IGNORE';
1678   local $SIG{TSTP} = 'IGNORE';
1679   local $SIG{PIPE} = 'IGNORE';
1680
1681   my $oldAutoCommit = $FS::UID::AutoCommit;
1682   local $FS::UID::AutoCommit = 0;
1683   my $dbh = dbh;
1684
1685   my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1686   my $error = $queue->insert( map $self->getfield($_), @fuzzyfields );
1687   if ( $error ) {
1688     $dbh->rollback if $oldAutoCommit;
1689     return "queueing job (transaction rolled back): $error";
1690   }
1691
1692   if ( $self->ship_last ) {
1693     $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' };
1694     $error = $queue->insert( map $self->getfield("ship_$_"), @fuzzyfields );
1695     if ( $error ) {
1696       $dbh->rollback if $oldAutoCommit;
1697       return "queueing job (transaction rolled back): $error";
1698     }
1699   }
1700
1701   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1702   '';
1703
1704 }
1705
1706 =item check
1707
1708 Checks all fields to make sure this is a valid customer record.  If there is
1709 an error, returns the error, otherwise returns false.  Called by the insert
1710 and replace methods.
1711
1712 =cut
1713
1714 sub check {
1715   my $self = shift;
1716
1717   warn "$me check BEFORE: \n". $self->_dump
1718     if $DEBUG > 2;
1719
1720   my $error =
1721     $self->ut_numbern('custnum')
1722     || $self->ut_number('agentnum')
1723     || $self->ut_textn('agent_custid')
1724     || $self->ut_number('refnum')
1725     || $self->ut_foreign_keyn('classnum', 'cust_class', 'classnum')
1726     || $self->ut_textn('custbatch')
1727     || $self->ut_name('last')
1728     || $self->ut_name('first')
1729     || $self->ut_snumbern('birthdate')
1730     || $self->ut_snumbern('signupdate')
1731     || $self->ut_textn('company')
1732     || $self->ut_text('address1')
1733     || $self->ut_textn('address2')
1734     || $self->ut_text('city')
1735     || $self->ut_textn('county')
1736     || $self->ut_textn('state')
1737     || $self->ut_country('country')
1738     || $self->ut_anything('comments')
1739     || $self->ut_numbern('referral_custnum')
1740     || $self->ut_textn('stateid')
1741     || $self->ut_textn('stateid_state')
1742     || $self->ut_textn('invoice_terms')
1743     || $self->ut_alphan('geocode')
1744     || $self->ut_floatn('cdr_termination_percentage')
1745   ;
1746
1747   #barf.  need message catalogs.  i18n.  etc.
1748   $error .= "Please select an advertising source."
1749     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
1750   return $error if $error;
1751
1752   return "Unknown agent"
1753     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
1754
1755   return "Unknown refnum"
1756     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
1757
1758   return "Unknown referring custnum: ". $self->referral_custnum
1759     unless ! $self->referral_custnum
1760            || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } );
1761
1762   if ( $self->censustract ne '' ) {
1763     $self->censustract =~ /^\s*(\d{9})\.?(\d{2})\s*$/
1764       or return "Illegal census tract: ". $self->censustract;
1765
1766     $self->censustract("$1.$2");
1767   }
1768
1769   if ( $self->ss eq '' ) {
1770     $self->ss('');
1771   } else {
1772     my $ss = $self->ss;
1773     $ss =~ s/\D//g;
1774     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
1775       or return "Illegal social security number: ". $self->ss;
1776     $self->ss("$1-$2-$3");
1777   }
1778
1779
1780 # bad idea to disable, causes billing to fail because of no tax rates later
1781 # except we don't fail any more
1782   unless ( $import ) {
1783     unless ( qsearch('cust_main_county', {
1784       'country' => $self->country,
1785       'state'   => '',
1786      } ) ) {
1787       return "Unknown state/county/country: ".
1788         $self->state. "/". $self->county. "/". $self->country
1789         unless qsearch('cust_main_county',{
1790           'state'   => $self->state,
1791           'county'  => $self->county,
1792           'country' => $self->country,
1793         } );
1794     }
1795   }
1796
1797   $error =
1798     $self->ut_phonen('daytime', $self->country)
1799     || $self->ut_phonen('night', $self->country)
1800     || $self->ut_phonen('fax', $self->country)
1801   ;
1802   return $error if $error;
1803
1804   unless ( $ignore_illegal_zip ) {
1805     $error = $self->ut_zip('zip', $self->country);
1806     return $error if $error;
1807   }
1808
1809   if ( $conf->exists('cust_main-require_phone')
1810        && ! length($self->daytime) && ! length($self->night)
1811      ) {
1812
1813     my $daytime_label = FS::Msgcat::_gettext('daytime') =~ /^(daytime)?$/
1814                           ? 'Day Phone'
1815                           : FS::Msgcat::_gettext('daytime');
1816     my $night_label = FS::Msgcat::_gettext('night') =~ /^(night)?$/
1817                         ? 'Night Phone'
1818                         : FS::Msgcat::_gettext('night');
1819
1820     return "$daytime_label or $night_label is required"
1821
1822   }
1823
1824   if ( $self->has_ship_address
1825        && scalar ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
1826                         $self->addr_fields )
1827      )
1828   {
1829     my $error =
1830       $self->ut_name('ship_last')
1831       || $self->ut_name('ship_first')
1832       || $self->ut_textn('ship_company')
1833       || $self->ut_text('ship_address1')
1834       || $self->ut_textn('ship_address2')
1835       || $self->ut_text('ship_city')
1836       || $self->ut_textn('ship_county')
1837       || $self->ut_textn('ship_state')
1838       || $self->ut_country('ship_country')
1839     ;
1840     return $error if $error;
1841
1842     #false laziness with above
1843     unless ( qsearchs('cust_main_county', {
1844       'country' => $self->ship_country,
1845       'state'   => '',
1846      } ) ) {
1847       return "Unknown ship_state/ship_county/ship_country: ".
1848         $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
1849         unless qsearch('cust_main_county',{
1850           'state'   => $self->ship_state,
1851           'county'  => $self->ship_county,
1852           'country' => $self->ship_country,
1853         } );
1854     }
1855     #eofalse
1856
1857     $error =
1858       $self->ut_phonen('ship_daytime', $self->ship_country)
1859       || $self->ut_phonen('ship_night', $self->ship_country)
1860       || $self->ut_phonen('ship_fax', $self->ship_country)
1861     ;
1862     return $error if $error;
1863
1864     unless ( $ignore_illegal_zip ) {
1865       $error = $self->ut_zip('ship_zip', $self->ship_country);
1866       return $error if $error;
1867     }
1868     return "Unit # is required."
1869       if $self->ship_address2 =~ /^\s*$/
1870       && $conf->exists('cust_main-require_address2');
1871
1872   } else { # ship_ info eq billing info, so don't store dup info in database
1873
1874     $self->setfield("ship_$_", '')
1875       foreach $self->addr_fields;
1876
1877     return "Unit # is required."
1878       if $self->address2 =~ /^\s*$/
1879       && $conf->exists('cust_main-require_address2');
1880
1881   }
1882
1883   #$self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/
1884   #  or return "Illegal payby: ". $self->payby;
1885   #$self->payby($1);
1886   FS::payby->can_payby($self->table, $self->payby)
1887     or return "Illegal payby: ". $self->payby;
1888
1889   $error =    $self->ut_numbern('paystart_month')
1890            || $self->ut_numbern('paystart_year')
1891            || $self->ut_numbern('payissue')
1892            || $self->ut_textn('paytype')
1893   ;
1894   return $error if $error;
1895
1896   if ( $self->payip eq '' ) {
1897     $self->payip('');
1898   } else {
1899     $error = $self->ut_ip('payip');
1900     return $error if $error;
1901   }
1902
1903   # If it is encrypted and the private key is not availaible then we can't
1904   # check the credit card.
1905   my $check_payinfo = ! $self->is_encrypted($self->payinfo);
1906
1907   if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) {
1908
1909     my $payinfo = $self->payinfo;
1910     $payinfo =~ s/\D//g;
1911     $payinfo =~ /^(\d{13,16})$/
1912       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1913     $payinfo = $1;
1914     $self->payinfo($payinfo);
1915     validate($payinfo)
1916       or return gettext('invalid_card'); # . ": ". $self->payinfo;
1917
1918     return gettext('unknown_card_type')
1919       if $self->payinfo !~ /^99\d{14}$/ #token
1920       && cardtype($self->payinfo) eq "Unknown";
1921
1922     unless ( $ignore_banned_card ) {
1923       my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1924       if ( $ban ) {
1925         return 'Banned credit card: banned on '.
1926                time2str('%a %h %o at %r', $ban->_date).
1927                ' by '. $ban->otaker.
1928                ' (ban# '. $ban->bannum. ')';
1929       }
1930     }
1931
1932     if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) {
1933       if ( cardtype($self->payinfo) eq 'American Express card' ) {
1934         $self->paycvv =~ /^(\d{4})$/
1935           or return "CVV2 (CID) for American Express cards is four digits.";
1936         $self->paycvv($1);
1937       } else {
1938         $self->paycvv =~ /^(\d{3})$/
1939           or return "CVV2 (CVC2/CID) is three digits.";
1940         $self->paycvv($1);
1941       }
1942     } else {
1943       $self->paycvv('');
1944     }
1945
1946     my $cardtype = cardtype($payinfo);
1947     if ( $cardtype =~ /^(Switch|Solo)$/i ) {
1948
1949       return "Start date or issue number is required for $cardtype cards"
1950         unless $self->paystart_month && $self->paystart_year or $self->payissue;
1951
1952       return "Start month must be between 1 and 12"
1953         if $self->paystart_month
1954            and $self->paystart_month < 1 || $self->paystart_month > 12;
1955
1956       return "Start year must be 1990 or later"
1957         if $self->paystart_year
1958            and $self->paystart_year < 1990;
1959
1960       return "Issue number must be beween 1 and 99"
1961         if $self->payissue
1962           and $self->payissue < 1 || $self->payissue > 99;
1963
1964     } else {
1965       $self->paystart_month('');
1966       $self->paystart_year('');
1967       $self->payissue('');
1968     }
1969
1970   } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) {
1971
1972     my $payinfo = $self->payinfo;
1973     $payinfo =~ s/[^\d\@]//g;
1974     if ( $conf->exists('echeck-nonus') ) {
1975       $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba';
1976       $payinfo = "$1\@$2";
1977     } else {
1978       $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba';
1979       $payinfo = "$1\@$2";
1980     }
1981     $self->payinfo($payinfo);
1982     $self->paycvv('');
1983
1984     my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref);
1985     if ( $ban ) {
1986       return 'Banned ACH account: banned on '.
1987              time2str('%a %h %o at %r', $ban->_date).
1988              ' by '. $ban->otaker.
1989              ' (ban# '. $ban->bannum. ')';
1990     }
1991
1992   } elsif ( $self->payby eq 'LECB' ) {
1993
1994     my $payinfo = $self->payinfo;
1995     $payinfo =~ s/\D//g;
1996     $payinfo =~ /^1?(\d{10})$/ or return 'invalid btn billing telephone number';
1997     $payinfo = $1;
1998     $self->payinfo($payinfo);
1999     $self->paycvv('');
2000
2001   } elsif ( $self->payby eq 'BILL' ) {
2002
2003     $error = $self->ut_textn('payinfo');
2004     return "Illegal P.O. number: ". $self->payinfo if $error;
2005     $self->paycvv('');
2006
2007   } elsif ( $self->payby eq 'COMP' ) {
2008
2009     my $curuser = $FS::CurrentUser::CurrentUser;
2010     if (    ! $self->custnum
2011          && ! $curuser->access_right('Complimentary customer')
2012        )
2013     {
2014       return "You are not permitted to create complimentary accounts."
2015     }
2016
2017     $error = $self->ut_textn('payinfo');
2018     return "Illegal comp account issuer: ". $self->payinfo if $error;
2019     $self->paycvv('');
2020
2021   } elsif ( $self->payby eq 'PREPAY' ) {
2022
2023     my $payinfo = $self->payinfo;
2024     $payinfo =~ s/\W//g; #anything else would just confuse things
2025     $self->payinfo($payinfo);
2026     $error = $self->ut_alpha('payinfo');
2027     return "Illegal prepayment identifier: ". $self->payinfo if $error;
2028     return "Unknown prepayment identifier"
2029       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
2030     $self->paycvv('');
2031
2032   }
2033
2034   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
2035     return "Expiration date required"
2036       unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/;
2037     $self->paydate('');
2038   } else {
2039     my( $m, $y );
2040     if ( $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/ ) {
2041       ( $m, $y ) = ( $1, length($2) == 4 ? $2 : "20$2" );
2042     } elsif ( $self->paydate =~ /^19(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2043       ( $m, $y ) = ( $2, "19$1" );
2044     } elsif ( $self->paydate =~ /^(20)?(\d{2})[\/\-](\d{1,2})[\/\-]\d+$/ ) {
2045       ( $m, $y ) = ( $3, "20$2" );
2046     } else {
2047       return "Illegal expiration date: ". $self->paydate;
2048     }
2049     $self->paydate("$y-$m-01");
2050     my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900;
2051     return gettext('expired_card')
2052       if !$import
2053       && !$ignore_expired_card
2054       && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) );
2055   }
2056
2057   if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ &&
2058        ( ! $conf->exists('require_cardname')
2059          || $self->payby !~ /^(CARD|DCRD)$/  )
2060   ) {
2061     $self->payname( $self->first. " ". $self->getfield('last') );
2062   } else {
2063     $self->payname =~ /^([\w \,\.\-\'\&]+)$/
2064       or return gettext('illegal_name'). " payname: ". $self->payname;
2065     $self->payname($1);
2066   }
2067
2068   foreach my $flag (qw( tax spool_cdr squelch_cdr archived email_csv_cdr )) {
2069     $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag();
2070     $self->$flag($1);
2071   }
2072
2073   $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
2074
2075   warn "$me check AFTER: \n". $self->_dump
2076     if $DEBUG > 2;
2077
2078   $self->SUPER::check;
2079 }
2080
2081 =item addr_fields
2082
2083 Returns a list of fields which have ship_ duplicates.
2084
2085 =cut
2086
2087 sub addr_fields {
2088   qw( last first company
2089       address1 address2 city county state zip country
2090       daytime night fax
2091     );
2092 }
2093
2094 =item has_ship_address
2095
2096 Returns true if this customer record has a separate shipping address.
2097
2098 =cut
2099
2100 sub has_ship_address {
2101   my $self = shift;
2102   scalar( grep { $self->getfield("ship_$_") ne '' } $self->addr_fields );
2103 }
2104
2105 =item location_hash
2106
2107 Returns a list of key/value pairs, with the following keys: address1, adddress2,
2108 city, county, state, zip, country.  The shipping address is used if present.
2109
2110 =cut
2111
2112 #geocode?  dependent on tax-ship_address config, not available in cust_location
2113 #mostly.  not yet then.
2114
2115 sub location_hash {
2116   my $self = shift;
2117   my $prefix = $self->has_ship_address ? 'ship_' : '';
2118
2119   map { $_ => $self->get($prefix.$_) }
2120       qw( address1 address2 city county state zip country geocode );
2121       #fields that cust_location has
2122 }
2123
2124 =item all_pkgs [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
2125
2126 Returns all packages (see L<FS::cust_pkg>) for this customer.
2127
2128 =cut
2129
2130 sub all_pkgs {
2131   my $self = shift;
2132   my $extra_qsearch = ref($_[0]) ? shift : { @_ };
2133
2134   return $self->num_pkgs unless wantarray || keys %$extra_qsearch;
2135
2136   my @cust_pkg = ();
2137   if ( $self->{'_pkgnum'} && ! keys %$extra_qsearch ) {
2138     @cust_pkg = values %{ $self->{'_pkgnum'}->cache };
2139   } else {
2140     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2141   }
2142
2143   map { $_ } sort sort_packages @cust_pkg;
2144 }
2145
2146 =item cust_pkg
2147
2148 Synonym for B<all_pkgs>.
2149
2150 =cut
2151
2152 sub cust_pkg {
2153   shift->all_pkgs(@_);
2154 }
2155
2156 =item cust_location
2157
2158 Returns all locations (see L<FS::cust_location>) for this customer.
2159
2160 =cut
2161
2162 sub cust_location {
2163   my $self = shift;
2164   qsearch('cust_location', { 'custnum' => $self->custnum } );
2165 }
2166
2167 =item location_label [ OPTION => VALUE ... ]
2168
2169 Returns the label of the service location (see analog in L<FS::cust_location>) for this customer.
2170
2171 Options are
2172
2173 =over 4
2174
2175 =item join_string
2176
2177 used to separate the address elements (defaults to ', ')
2178
2179 =item escape_function
2180
2181 a callback used for escaping the text of the address elements
2182
2183 =back
2184
2185 =cut
2186
2187 # false laziness with FS::cust_location::line
2188
2189 sub location_label {
2190   my $self = shift;
2191   my %opt = @_;
2192
2193   my $separator = $opt{join_string} || ', ';
2194   my $escape = $opt{escape_function} || sub{ shift };
2195   my $line = '';
2196   my $cydefault = FS::conf->new->config('countrydefault') || 'US';
2197   my $prefix = length($self->ship_last) ? 'ship_' : '';
2198
2199   my $notfirst = 0;
2200   foreach (qw ( address1 address2 ) ) {
2201     my $method = "$prefix$_";
2202     $line .= ($notfirst ? $separator : ''). &$escape($self->$method)
2203       if $self->$method;
2204     $notfirst++;
2205   }
2206   $notfirst = 0;
2207   foreach (qw ( city county state zip ) ) {
2208     my $method = "$prefix$_";
2209     if ( $self->$method ) {
2210       $line .= ' (' if $method eq 'county';
2211       $line .= ($notfirst ? ' ' : $separator). &$escape($self->$method);
2212       $line .= ' )' if $method eq 'county';
2213       $notfirst++;
2214     }
2215   }
2216   $line .= $separator. &$escape(code2country($self->country))
2217     if $self->country ne $cydefault;
2218
2219   $line;
2220 }
2221
2222 =item ncancelled_pkgs [ EXTRA_QSEARCH_PARAMS_HASHREF ]
2223
2224 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
2225
2226 =cut
2227
2228 sub ncancelled_pkgs {
2229   my $self = shift;
2230   my $extra_qsearch = ref($_[0]) ? shift : {};
2231
2232   return $self->num_ncancelled_pkgs unless wantarray;
2233
2234   my @cust_pkg = ();
2235   if ( $self->{'_pkgnum'} ) {
2236
2237     warn "$me ncancelled_pkgs: returning cached objects"
2238       if $DEBUG > 1;
2239
2240     @cust_pkg = grep { ! $_->getfield('cancel') }
2241                 values %{ $self->{'_pkgnum'}->cache };
2242
2243   } else {
2244
2245     warn "$me ncancelled_pkgs: searching for packages with custnum ".
2246          $self->custnum. "\n"
2247       if $DEBUG > 1;
2248
2249     $extra_qsearch->{'extra_sql'} .= ' AND ( cancel IS NULL OR cancel = 0 ) ';
2250
2251     @cust_pkg = $self->_cust_pkg($extra_qsearch);
2252
2253   }
2254
2255   sort sort_packages @cust_pkg;
2256
2257 }
2258
2259 sub _cust_pkg {
2260   my $self = shift;
2261   my $extra_qsearch = ref($_[0]) ? shift : {};
2262
2263   $extra_qsearch->{'select'} ||= '*';
2264   $extra_qsearch->{'select'} .=
2265    ',( SELECT COUNT(*) FROM cust_svc WHERE cust_pkg.pkgnum = cust_svc.pkgnum )
2266      AS _num_cust_svc';
2267
2268   map {
2269         $_->{'_num_cust_svc'} = $_->get('_num_cust_svc');
2270         $_;
2271       }
2272   qsearch({
2273     %$extra_qsearch,
2274     'table'   => 'cust_pkg',
2275     'hashref' => { 'custnum' => $self->custnum },
2276   });
2277
2278 }
2279
2280 # This should be generalized to use config options to determine order.
2281 sub sort_packages {
2282
2283   my $locationsort = ( $a->locationnum || 0 ) <=> ( $b->locationnum || 0 );
2284   return $locationsort if $locationsort;
2285
2286   if ( $a->get('cancel') xor $b->get('cancel') ) {
2287     return -1 if $b->get('cancel');
2288     return  1 if $a->get('cancel');
2289     #shouldn't get here...
2290     return 0;
2291   } else {
2292     my $a_num_cust_svc = $a->num_cust_svc;
2293     my $b_num_cust_svc = $b->num_cust_svc;
2294     return 0  if !$a_num_cust_svc && !$b_num_cust_svc;
2295     return -1 if  $a_num_cust_svc && !$b_num_cust_svc;
2296     return 1  if !$a_num_cust_svc &&  $b_num_cust_svc;
2297     my @a_cust_svc = $a->cust_svc;
2298     my @b_cust_svc = $b->cust_svc;
2299     return 0  if !scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2300     return -1 if  scalar(@a_cust_svc) && !scalar(@b_cust_svc);
2301     return 1  if !scalar(@a_cust_svc) &&  scalar(@b_cust_svc);
2302     $a_cust_svc[0]->svc_x->label cmp $b_cust_svc[0]->svc_x->label;
2303   }
2304
2305 }
2306
2307 =item suspended_pkgs
2308
2309 Returns all suspended packages (see L<FS::cust_pkg>) for this customer.
2310
2311 =cut
2312
2313 sub suspended_pkgs {
2314   my $self = shift;
2315   grep { $_->susp } $self->ncancelled_pkgs;
2316 }
2317
2318 =item unflagged_suspended_pkgs
2319
2320 Returns all unflagged suspended packages (see L<FS::cust_pkg>) for this
2321 customer (thouse packages without the `manual_flag' set).
2322
2323 =cut
2324
2325 sub unflagged_suspended_pkgs {
2326   my $self = shift;
2327   return $self->suspended_pkgs
2328     unless dbdef->table('cust_pkg')->column('manual_flag');
2329   grep { ! $_->manual_flag } $self->suspended_pkgs;
2330 }
2331
2332 =item unsuspended_pkgs
2333
2334 Returns all unsuspended (and uncancelled) packages (see L<FS::cust_pkg>) for
2335 this customer.
2336
2337 =cut
2338
2339 sub unsuspended_pkgs {
2340   my $self = shift;
2341   grep { ! $_->susp } $self->ncancelled_pkgs;
2342 }
2343
2344 =item next_bill_date
2345
2346 Returns the next date this customer will be billed, as a UNIX timestamp, or
2347 undef if no active package has a next bill date.
2348
2349 =cut
2350
2351 sub next_bill_date {
2352   my $self = shift;
2353   min( map $_->get('bill'), grep $_->get('bill'), $self->unsuspended_pkgs );
2354 }
2355
2356 =item num_cancelled_pkgs
2357
2358 Returns the number of cancelled packages (see L<FS::cust_pkg>) for this
2359 customer.
2360
2361 =cut
2362
2363 sub num_cancelled_pkgs {
2364   shift->num_pkgs("cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0");
2365 }
2366
2367 sub num_ncancelled_pkgs {
2368   shift->num_pkgs("( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )");
2369 }
2370
2371 sub num_pkgs {
2372   my( $self ) = shift;
2373   my $sql = scalar(@_) ? shift : '';
2374   $sql = "AND $sql" if $sql && $sql !~ /^\s*$/ && $sql !~ /^\s*AND/i;
2375   my $sth = dbh->prepare(
2376     "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? $sql"
2377   ) or die dbh->errstr;
2378   $sth->execute($self->custnum) or die $sth->errstr;
2379   $sth->fetchrow_arrayref->[0];
2380 }
2381
2382 =item unsuspend
2383
2384 Unsuspends all unflagged suspended packages (see L</unflagged_suspended_pkgs>
2385 and L<FS::cust_pkg>) for this customer.  Always returns a list: an empty list
2386 on success or a list of errors.
2387
2388 =cut
2389
2390 sub unsuspend {
2391   my $self = shift;
2392   grep { $_->unsuspend } $self->suspended_pkgs;
2393 }
2394
2395 =item suspend
2396
2397 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2398
2399 Returns a list: an empty list on success or a list of errors.
2400
2401 =cut
2402
2403 sub suspend {
2404   my $self = shift;
2405   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2406 }
2407
2408 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2409
2410 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2411 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2412 of a list of pkgparts; the hashref has the following keys:
2413
2414 =over 4
2415
2416 =item pkgparts - listref of pkgparts
2417
2418 =item (other options are passed to the suspend method)
2419
2420 =back
2421
2422
2423 Returns a list: an empty list on success or a list of errors.
2424
2425 =cut
2426
2427 sub suspend_if_pkgpart {
2428   my $self = shift;
2429   my (@pkgparts, %opt);
2430   if (ref($_[0]) eq 'HASH'){
2431     @pkgparts = @{$_[0]{pkgparts}};
2432     %opt      = %{$_[0]};
2433   }else{
2434     @pkgparts = @_;
2435   }
2436   grep { $_->suspend(%opt) }
2437     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2438       $self->unsuspended_pkgs;
2439 }
2440
2441 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2442
2443 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2444 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2445 instead of a list of pkgparts; the hashref has the following keys:
2446
2447 =over 4
2448
2449 =item pkgparts - listref of pkgparts
2450
2451 =item (other options are passed to the suspend method)
2452
2453 =back
2454
2455 Returns a list: an empty list on success or a list of errors.
2456
2457 =cut
2458
2459 sub suspend_unless_pkgpart {
2460   my $self = shift;
2461   my (@pkgparts, %opt);
2462   if (ref($_[0]) eq 'HASH'){
2463     @pkgparts = @{$_[0]{pkgparts}};
2464     %opt      = %{$_[0]};
2465   }else{
2466     @pkgparts = @_;
2467   }
2468   grep { $_->suspend(%opt) }
2469     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2470       $self->unsuspended_pkgs;
2471 }
2472
2473 =item cancel [ OPTION => VALUE ... ]
2474
2475 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2476
2477 Available options are:
2478
2479 =over 4
2480
2481 =item quiet - can be set true to supress email cancellation notices.
2482
2483 =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.
2484
2485 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2486
2487 =item nobill - can be set true to skip billing if it might otherwise be done.
2488
2489 =back
2490
2491 Always returns a list: an empty list on success or a list of errors.
2492
2493 =cut
2494
2495 # nb that dates are not specified as valid options to this method
2496
2497 sub cancel {
2498   my( $self, %opt ) = @_;
2499
2500   warn "$me cancel called on customer ". $self->custnum. " with options ".
2501        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2502     if $DEBUG;
2503
2504   return ( 'access denied' )
2505     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2506
2507   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2508
2509     #should try decryption (we might have the private key)
2510     # and if not maybe queue a job for the server that does?
2511     return ( "Can't (yet) ban encrypted credit cards" )
2512       if $self->is_encrypted($self->payinfo);
2513
2514     my $ban = new FS::banned_pay $self->_banned_pay_hashref;
2515     my $error = $ban->insert;
2516     return ( $error ) if $error;
2517
2518   }
2519
2520   my @pkgs = $self->ncancelled_pkgs;
2521
2522   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2523     $opt{nobill} = 1;
2524     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2525     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2526       if $error;
2527   }
2528
2529   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2530        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2531     if $DEBUG;
2532
2533   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2534 }
2535
2536 sub _banned_pay_hashref {
2537   my $self = shift;
2538
2539   my %payby2ban = (
2540     'CARD' => 'CARD',
2541     'DCRD' => 'CARD',
2542     'CHEK' => 'CHEK',
2543     'DCHK' => 'CHEK'
2544   );
2545
2546   {
2547     'payby'   => $payby2ban{$self->payby},
2548     'payinfo' => md5_base64($self->payinfo),
2549     #don't ever *search* on reason! #'reason'  =>
2550   };
2551 }
2552
2553 =item notes
2554
2555 Returns all notes (see L<FS::cust_main_note>) for this customer.
2556
2557 =cut
2558
2559 sub notes {
2560   my $self = shift;
2561   #order by?
2562   qsearch( 'cust_main_note',
2563            { 'custnum' => $self->custnum },
2564            '',
2565            'ORDER BY _DATE DESC'
2566          );
2567 }
2568
2569 =item agent
2570
2571 Returns the agent (see L<FS::agent>) for this customer.
2572
2573 =cut
2574
2575 sub agent {
2576   my $self = shift;
2577   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2578 }
2579
2580 =item agent_name
2581
2582 Returns the agent name (see L<FS::agent>) for this customer.
2583
2584 =cut
2585
2586 sub agent_name {
2587   my $self = shift;
2588   $self->agent->agent;
2589 }
2590
2591 =item cust_tag
2592
2593 Returns any tags associated with this customer, as FS::cust_tag objects,
2594 or an empty list if there are no tags.
2595
2596 =cut
2597
2598 sub cust_tag {
2599   my $self = shift;
2600   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2601 }
2602
2603 =item part_tag
2604
2605 Returns any tags associated with this customer, as FS::part_tag objects,
2606 or an empty list if there are no tags.
2607
2608 =cut
2609
2610 sub part_tag {
2611   my $self = shift;
2612   map $_->part_tag, $self->cust_tag;
2613 }
2614
2615
2616 =item cust_class
2617
2618 Returns the customer class, as an FS::cust_class object, or the empty string
2619 if there is no customer class.
2620
2621 =cut
2622
2623 sub cust_class {
2624   my $self = shift;
2625   if ( $self->classnum ) {
2626     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2627   } else {
2628     return '';
2629   }
2630 }
2631
2632 =item categoryname
2633
2634 Returns the customer category name, or the empty string if there is no customer
2635 category.
2636
2637 =cut
2638
2639 sub categoryname {
2640   my $self = shift;
2641   my $cust_class = $self->cust_class;
2642   $cust_class
2643     ? $cust_class->categoryname
2644     : '';
2645 }
2646
2647 =item classname
2648
2649 Returns the customer class name, or the empty string if there is no customer
2650 class.
2651
2652 =cut
2653
2654 sub classname {
2655   my $self = shift;
2656   my $cust_class = $self->cust_class;
2657   $cust_class
2658     ? $cust_class->classname
2659     : '';
2660 }
2661
2662 =item BILLING METHODS
2663
2664 Documentation on billing methods has been moved to
2665 L<FS::cust_main::Billing>.
2666
2667 =item REALTIME BILLING METHODS
2668
2669 Documentation on realtime billing methods has been moved to
2670 L<FS::cust_main::Billing_Realtime>.
2671
2672 =item remove_cvv
2673
2674 Removes the I<paycvv> field from the database directly.
2675
2676 If there is an error, returns the error, otherwise returns false.
2677
2678 =cut
2679
2680 sub remove_cvv {
2681   my $self = shift;
2682   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2683     or return dbh->errstr;
2684   $sth->execute($self->custnum)
2685     or return $sth->errstr;
2686   $self->paycvv('');
2687   '';
2688 }
2689
2690 =item batch_card OPTION => VALUE...
2691
2692 Adds a payment for this invoice to the pending credit card batch (see
2693 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2694 runs the payment using a realtime gateway.
2695
2696 =cut
2697
2698 sub batch_card {
2699   my ($self, %options) = @_;
2700
2701   my $amount;
2702   if (exists($options{amount})) {
2703     $amount = $options{amount};
2704   }else{
2705     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2706   }
2707   return '' unless $amount > 0;
2708
2709   my $invnum = delete $options{invnum};
2710   my $payby = $options{invnum} || $self->payby;  #dubious
2711
2712   if ($options{'realtime'}) {
2713     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2714                                 $amount,
2715                                 %options,
2716                               );
2717   }
2718
2719   my $oldAutoCommit = $FS::UID::AutoCommit;
2720   local $FS::UID::AutoCommit = 0;
2721   my $dbh = dbh;
2722
2723   #this needs to handle mysql as well as Pg, like svc_acct.pm
2724   #(make it into a common function if folks need to do batching with mysql)
2725   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2726     or return "Cannot lock pay_batch: " . $dbh->errstr;
2727
2728   my %pay_batch = (
2729     'status' => 'O',
2730     'payby'  => FS::payby->payby2payment($payby),
2731   );
2732
2733   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2734
2735   unless ( $pay_batch ) {
2736     $pay_batch = new FS::pay_batch \%pay_batch;
2737     my $error = $pay_batch->insert;
2738     if ( $error ) {
2739       $dbh->rollback if $oldAutoCommit;
2740       die "error creating new batch: $error\n";
2741     }
2742   }
2743
2744   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2745       'batchnum' => $pay_batch->batchnum,
2746       'custnum'  => $self->custnum,
2747   } );
2748
2749   foreach (qw( address1 address2 city state zip country payby payinfo paydate
2750                payname )) {
2751     $options{$_} = '' unless exists($options{$_});
2752   }
2753
2754   my $cust_pay_batch = new FS::cust_pay_batch ( {
2755     'batchnum' => $pay_batch->batchnum,
2756     'invnum'   => $invnum || 0,                    # is there a better value?
2757                                                    # this field should be
2758                                                    # removed...
2759                                                    # cust_bill_pay_batch now
2760     'custnum'  => $self->custnum,
2761     'last'     => $self->getfield('last'),
2762     'first'    => $self->getfield('first'),
2763     'address1' => $options{address1} || $self->address1,
2764     'address2' => $options{address2} || $self->address2,
2765     'city'     => $options{city}     || $self->city,
2766     'state'    => $options{state}    || $self->state,
2767     'zip'      => $options{zip}      || $self->zip,
2768     'country'  => $options{country}  || $self->country,
2769     'payby'    => $options{payby}    || $self->payby,
2770     'payinfo'  => $options{payinfo}  || $self->payinfo,
2771     'exp'      => $options{paydate}  || $self->paydate,
2772     'payname'  => $options{payname}  || $self->payname,
2773     'amount'   => $amount,                         # consolidating
2774   } );
2775
2776   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2777     if $old_cust_pay_batch;
2778
2779   my $error;
2780   if ($old_cust_pay_batch) {
2781     $error = $cust_pay_batch->replace($old_cust_pay_batch)
2782   } else {
2783     $error = $cust_pay_batch->insert;
2784   }
2785
2786   if ( $error ) {
2787     $dbh->rollback if $oldAutoCommit;
2788     die $error;
2789   }
2790
2791   my $unapplied =   $self->total_unapplied_credits
2792                   + $self->total_unapplied_payments
2793                   + $self->in_transit_payments;
2794   foreach my $cust_bill ($self->open_cust_bill) {
2795     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2796     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2797       'invnum' => $cust_bill->invnum,
2798       'paybatchnum' => $cust_pay_batch->paybatchnum,
2799       'amount' => $cust_bill->owed,
2800       '_date' => time,
2801     };
2802     if ($unapplied >= $cust_bill_pay_batch->amount){
2803       $unapplied -= $cust_bill_pay_batch->amount;
2804       next;
2805     }else{
2806       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2807                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
2808     }
2809     $error = $cust_bill_pay_batch->insert;
2810     if ( $error ) {
2811       $dbh->rollback if $oldAutoCommit;
2812       die $error;
2813     }
2814   }
2815
2816   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2817   '';
2818 }
2819
2820 =item total_owed
2821
2822 Returns the total owed for this customer on all invoices
2823 (see L<FS::cust_bill/owed>).
2824
2825 =cut
2826
2827 sub total_owed {
2828   my $self = shift;
2829   $self->total_owed_date(2145859200); #12/31/2037
2830 }
2831
2832 =item total_owed_date TIME
2833
2834 Returns the total owed for this customer on all invoices with date earlier than
2835 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2836 see L<Time::Local> and L<Date::Parse> for conversion functions.
2837
2838 =cut
2839
2840 sub total_owed_date {
2841   my $self = shift;
2842   my $time = shift;
2843
2844   my $custnum = $self->custnum;
2845
2846   my $owed_sql = FS::cust_bill->owed_sql;
2847
2848   my $sql = "
2849     SELECT SUM($owed_sql) FROM cust_bill
2850       WHERE custnum = $custnum
2851         AND _date <= $time
2852   ";
2853
2854   sprintf( "%.2f", $self->scalar_sql($sql) );
2855
2856 }
2857
2858 =item total_owed_pkgnum PKGNUM
2859
2860 Returns the total owed on all invoices for this customer's specific package
2861 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2862
2863 =cut
2864
2865 sub total_owed_pkgnum {
2866   my( $self, $pkgnum ) = @_;
2867   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2868 }
2869
2870 =item total_owed_date_pkgnum TIME PKGNUM
2871
2872 Returns the total owed for this customer's specific package when using
2873 experimental package balances on all invoices with date earlier than
2874 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2875 see L<Time::Local> and L<Date::Parse> for conversion functions.
2876
2877 =cut
2878
2879 sub total_owed_date_pkgnum {
2880   my( $self, $time, $pkgnum ) = @_;
2881
2882   my $total_bill = 0;
2883   foreach my $cust_bill (
2884     grep { $_->_date <= $time }
2885       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2886   ) {
2887     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2888   }
2889   sprintf( "%.2f", $total_bill );
2890
2891 }
2892
2893 =item total_paid
2894
2895 Returns the total amount of all payments.
2896
2897 =cut
2898
2899 sub total_paid {
2900   my $self = shift;
2901   my $total = 0;
2902   $total += $_->paid foreach $self->cust_pay;
2903   sprintf( "%.2f", $total );
2904 }
2905
2906 =item total_unapplied_credits
2907
2908 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2909 customer.  See L<FS::cust_credit/credited>.
2910
2911 =item total_credited
2912
2913 Old name for total_unapplied_credits.  Don't use.
2914
2915 =cut
2916
2917 sub total_credited {
2918   #carp "total_credited deprecated, use total_unapplied_credits";
2919   shift->total_unapplied_credits(@_);
2920 }
2921
2922 sub total_unapplied_credits {
2923   my $self = shift;
2924
2925   my $custnum = $self->custnum;
2926
2927   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2928
2929   my $sql = "
2930     SELECT SUM($unapplied_sql) FROM cust_credit
2931       WHERE custnum = $custnum
2932   ";
2933
2934   sprintf( "%.2f", $self->scalar_sql($sql) );
2935
2936 }
2937
2938 =item total_unapplied_credits_pkgnum PKGNUM
2939
2940 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2941 customer.  See L<FS::cust_credit/credited>.
2942
2943 =cut
2944
2945 sub total_unapplied_credits_pkgnum {
2946   my( $self, $pkgnum ) = @_;
2947   my $total_credit = 0;
2948   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2949   sprintf( "%.2f", $total_credit );
2950 }
2951
2952
2953 =item total_unapplied_payments
2954
2955 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2956 See L<FS::cust_pay/unapplied>.
2957
2958 =cut
2959
2960 sub total_unapplied_payments {
2961   my $self = shift;
2962
2963   my $custnum = $self->custnum;
2964
2965   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2966
2967   my $sql = "
2968     SELECT SUM($unapplied_sql) FROM cust_pay
2969       WHERE custnum = $custnum
2970   ";
2971
2972   sprintf( "%.2f", $self->scalar_sql($sql) );
2973
2974 }
2975
2976 =item total_unapplied_payments_pkgnum PKGNUM
2977
2978 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2979 specific package when using experimental package balances.  See
2980 L<FS::cust_pay/unapplied>.
2981
2982 =cut
2983
2984 sub total_unapplied_payments_pkgnum {
2985   my( $self, $pkgnum ) = @_;
2986   my $total_unapplied = 0;
2987   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2988   sprintf( "%.2f", $total_unapplied );
2989 }
2990
2991
2992 =item total_unapplied_refunds
2993
2994 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2995 customer.  See L<FS::cust_refund/unapplied>.
2996
2997 =cut
2998
2999 sub total_unapplied_refunds {
3000   my $self = shift;
3001   my $custnum = $self->custnum;
3002
3003   my $unapplied_sql = FS::cust_refund->unapplied_sql;
3004
3005   my $sql = "
3006     SELECT SUM($unapplied_sql) FROM cust_refund
3007       WHERE custnum = $custnum
3008   ";
3009
3010   sprintf( "%.2f", $self->scalar_sql($sql) );
3011
3012 }
3013
3014 =item balance
3015
3016 Returns the balance for this customer (total_owed plus total_unrefunded, minus
3017 total_unapplied_credits minus total_unapplied_payments).
3018
3019 =cut
3020
3021 sub balance {
3022   my $self = shift;
3023   $self->balance_date_range;
3024 }
3025
3026 =item balance_date TIME
3027
3028 Returns the balance for this customer, only considering invoices with date
3029 earlier than TIME (total_owed_date minus total_credited minus
3030 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
3031 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
3032 functions.
3033
3034 =cut
3035
3036 sub balance_date {
3037   my $self = shift;
3038   $self->balance_date_range(shift);
3039 }
3040
3041 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
3042
3043 Returns the balance for this customer, optionally considering invoices with
3044 date earlier than START_TIME, and not later than END_TIME
3045 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
3046
3047 Times are specified as SQL fragments or numeric
3048 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
3049 L<Date::Parse> for conversion functions.  The empty string can be passed
3050 to disable that time constraint completely.
3051
3052 Available options are:
3053
3054 =over 4
3055
3056 =item unapplied_date
3057
3058 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)
3059
3060 =back
3061
3062 =cut
3063
3064 sub balance_date_range {
3065   my $self = shift;
3066   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
3067             ') FROM cust_main WHERE custnum='. $self->custnum;
3068   sprintf( '%.2f', $self->scalar_sql($sql) );
3069 }
3070
3071 =item balance_pkgnum PKGNUM
3072
3073 Returns the balance for this customer's specific package when using
3074 experimental package balances (total_owed plus total_unrefunded, minus
3075 total_unapplied_credits minus total_unapplied_payments)
3076
3077 =cut
3078
3079 sub balance_pkgnum {
3080   my( $self, $pkgnum ) = @_;
3081
3082   sprintf( "%.2f",
3083       $self->total_owed_pkgnum($pkgnum)
3084 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
3085 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
3086     - $self->total_unapplied_credits_pkgnum($pkgnum)
3087     - $self->total_unapplied_payments_pkgnum($pkgnum)
3088   );
3089 }
3090
3091 =item in_transit_payments
3092
3093 Returns the total of requests for payments for this customer pending in
3094 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
3095
3096 =cut
3097
3098 sub in_transit_payments {
3099   my $self = shift;
3100   my $in_transit_payments = 0;
3101   foreach my $pay_batch ( qsearch('pay_batch', {
3102     'status' => 'I',
3103   } ) ) {
3104     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
3105       'batchnum' => $pay_batch->batchnum,
3106       'custnum' => $self->custnum,
3107     } ) ) {
3108       $in_transit_payments += $cust_pay_batch->amount;
3109     }
3110   }
3111   sprintf( "%.2f", $in_transit_payments );
3112 }
3113
3114 =item payment_info
3115
3116 Returns a hash of useful information for making a payment.
3117
3118 =over 4
3119
3120 =item balance
3121
3122 Current balance.
3123
3124 =item payby
3125
3126 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
3127 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
3128 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
3129
3130 =back
3131
3132 For credit card transactions:
3133
3134 =over 4
3135
3136 =item card_type 1
3137
3138 =item payname
3139
3140 Exact name on card
3141
3142 =back
3143
3144 For electronic check transactions:
3145
3146 =over 4
3147
3148 =item stateid_state
3149
3150 =back
3151
3152 =cut
3153
3154 sub payment_info {
3155   my $self = shift;
3156
3157   my %return = ();
3158
3159   $return{balance} = $self->balance;
3160
3161   $return{payname} = $self->payname
3162                      || ( $self->first. ' '. $self->get('last') );
3163
3164   $return{$_} = $self->get($_) for qw(address1 address2 city state zip);
3165
3166   $return{payby} = $self->payby;
3167   $return{stateid_state} = $self->stateid_state;
3168
3169   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
3170     $return{card_type} = cardtype($self->payinfo);
3171     $return{payinfo} = $self->paymask;
3172
3173     @return{'month', 'year'} = $self->paydate_monthyear;
3174
3175   }
3176
3177   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
3178     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
3179     $return{payinfo1} = $payinfo1;
3180     $return{payinfo2} = $payinfo2;
3181     $return{paytype}  = $self->paytype;
3182     $return{paystate} = $self->paystate;
3183
3184   }
3185
3186   #doubleclick protection
3187   my $_date = time;
3188   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
3189
3190   %return;
3191
3192 }
3193
3194 =item paydate_monthyear
3195
3196 Returns a two-element list consisting of the month and year of this customer's
3197 paydate (credit card expiration date for CARD customers)
3198
3199 =cut
3200
3201 sub paydate_monthyear {
3202   my $self = shift;
3203   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3204     ( $2, $1 );
3205   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3206     ( $1, $3 );
3207   } else {
3208     ('', '');
3209   }
3210 }
3211
3212 =item tax_exemption TAXNAME
3213
3214 =cut
3215
3216 sub tax_exemption {
3217   my( $self, $taxname ) = @_;
3218
3219   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3220                                      'taxname' => $taxname,
3221                                    },
3222           );
3223 }
3224
3225 =item cust_main_exemption
3226
3227 =cut
3228
3229 sub cust_main_exemption {
3230   my $self = shift;
3231   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3232 }
3233
3234 =item invoicing_list [ ARRAYREF ]
3235
3236 If an arguement is given, sets these email addresses as invoice recipients
3237 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3238 (except as warnings), so use check_invoicing_list first.
3239
3240 Returns a list of email addresses (with svcnum entries expanded).
3241
3242 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3243 check it without disturbing anything by passing nothing.
3244
3245 This interface may change in the future.
3246
3247 =cut
3248
3249 sub invoicing_list {
3250   my( $self, $arrayref ) = @_;
3251
3252   if ( $arrayref ) {
3253     my @cust_main_invoice;
3254     if ( $self->custnum ) {
3255       @cust_main_invoice =
3256         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3257     } else {
3258       @cust_main_invoice = ();
3259     }
3260     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3261       #warn $cust_main_invoice->destnum;
3262       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3263         #warn $cust_main_invoice->destnum;
3264         my $error = $cust_main_invoice->delete;
3265         warn $error if $error;
3266       }
3267     }
3268     if ( $self->custnum ) {
3269       @cust_main_invoice =
3270         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3271     } else {
3272       @cust_main_invoice = ();
3273     }
3274     my %seen = map { $_->address => 1 } @cust_main_invoice;
3275     foreach my $address ( @{$arrayref} ) {
3276       next if exists $seen{$address} && $seen{$address};
3277       $seen{$address} = 1;
3278       my $cust_main_invoice = new FS::cust_main_invoice ( {
3279         'custnum' => $self->custnum,
3280         'dest'    => $address,
3281       } );
3282       my $error = $cust_main_invoice->insert;
3283       warn $error if $error;
3284     }
3285   }
3286
3287   if ( $self->custnum ) {
3288     map { $_->address }
3289       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3290   } else {
3291     ();
3292   }
3293
3294 }
3295
3296 =item check_invoicing_list ARRAYREF
3297
3298 Checks these arguements as valid input for the invoicing_list method.  If there
3299 is an error, returns the error, otherwise returns false.
3300
3301 =cut
3302
3303 sub check_invoicing_list {
3304   my( $self, $arrayref ) = @_;
3305
3306   foreach my $address ( @$arrayref ) {
3307
3308     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3309       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3310     }
3311
3312     my $cust_main_invoice = new FS::cust_main_invoice ( {
3313       'custnum' => $self->custnum,
3314       'dest'    => $address,
3315     } );
3316     my $error = $self->custnum
3317                 ? $cust_main_invoice->check
3318                 : $cust_main_invoice->checkdest
3319     ;
3320     return $error if $error;
3321
3322   }
3323
3324   return "Email address required"
3325     if $conf->exists('cust_main-require_invoicing_list_email')
3326     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3327
3328   '';
3329 }
3330
3331 =item set_default_invoicing_list
3332
3333 Sets the invoicing list to all accounts associated with this customer,
3334 overwriting any previous invoicing list.
3335
3336 =cut
3337
3338 sub set_default_invoicing_list {
3339   my $self = shift;
3340   $self->invoicing_list($self->all_emails);
3341 }
3342
3343 =item all_emails
3344
3345 Returns the email addresses of all accounts provisioned for this customer.
3346
3347 =cut
3348
3349 sub all_emails {
3350   my $self = shift;
3351   my %list;
3352   foreach my $cust_pkg ( $self->all_pkgs ) {
3353     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3354     my @svc_acct =
3355       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3356         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3357           @cust_svc;
3358     $list{$_}=1 foreach map { $_->email } @svc_acct;
3359   }
3360   keys %list;
3361 }
3362
3363 =item invoicing_list_addpost
3364
3365 Adds postal invoicing to this customer.  If this customer is already configured
3366 to receive postal invoices, does nothing.
3367
3368 =cut
3369
3370 sub invoicing_list_addpost {
3371   my $self = shift;
3372   return if grep { $_ eq 'POST' } $self->invoicing_list;
3373   my @invoicing_list = $self->invoicing_list;
3374   push @invoicing_list, 'POST';
3375   $self->invoicing_list(\@invoicing_list);
3376 }
3377
3378 =item invoicing_list_emailonly
3379
3380 Returns the list of email invoice recipients (invoicing_list without non-email
3381 destinations such as POST and FAX).
3382
3383 =cut
3384
3385 sub invoicing_list_emailonly {
3386   my $self = shift;
3387   warn "$me invoicing_list_emailonly called"
3388     if $DEBUG;
3389   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3390 }
3391
3392 =item invoicing_list_emailonly_scalar
3393
3394 Returns the list of email invoice recipients (invoicing_list without non-email
3395 destinations such as POST and FAX) as a comma-separated scalar.
3396
3397 =cut
3398
3399 sub invoicing_list_emailonly_scalar {
3400   my $self = shift;
3401   warn "$me invoicing_list_emailonly_scalar called"
3402     if $DEBUG;
3403   join(', ', $self->invoicing_list_emailonly);
3404 }
3405
3406 =item referral_custnum_cust_main
3407
3408 Returns the customer who referred this customer (or the empty string, if
3409 this customer was not referred).
3410
3411 Note the difference with referral_cust_main method: This method,
3412 referral_custnum_cust_main returns the single customer (if any) who referred
3413 this customer, while referral_cust_main returns an array of customers referred
3414 BY this customer.
3415
3416 =cut
3417
3418 sub referral_custnum_cust_main {
3419   my $self = shift;
3420   return '' unless $self->referral_custnum;
3421   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3422 }
3423
3424 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3425
3426 Returns an array of customers referred by this customer (referral_custnum set
3427 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3428 customers referred by customers referred by this customer and so on, inclusive.
3429 The default behavior is DEPTH 1 (no recursion).
3430
3431 Note the difference with referral_custnum_cust_main method: This method,
3432 referral_cust_main, returns an array of customers referred BY this customer,
3433 while referral_custnum_cust_main returns the single customer (if any) who
3434 referred this customer.
3435
3436 =cut
3437
3438 sub referral_cust_main {
3439   my $self = shift;
3440   my $depth = @_ ? shift : 1;
3441   my $exclude = @_ ? shift : {};
3442
3443   my @cust_main =
3444     map { $exclude->{$_->custnum}++; $_; }
3445       grep { ! $exclude->{ $_->custnum } }
3446         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3447
3448   if ( $depth > 1 ) {
3449     push @cust_main,
3450       map { $_->referral_cust_main($depth-1, $exclude) }
3451         @cust_main;
3452   }
3453
3454   @cust_main;
3455 }
3456
3457 =item referral_cust_main_ncancelled
3458
3459 Same as referral_cust_main, except only returns customers with uncancelled
3460 packages.
3461
3462 =cut
3463
3464 sub referral_cust_main_ncancelled {
3465   my $self = shift;
3466   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3467 }
3468
3469 =item referral_cust_pkg [ DEPTH ]
3470
3471 Like referral_cust_main, except returns a flat list of all unsuspended (and
3472 uncancelled) packages for each customer.  The number of items in this list may
3473 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3474
3475 =cut
3476
3477 sub referral_cust_pkg {
3478   my $self = shift;
3479   my $depth = @_ ? shift : 1;
3480
3481   map { $_->unsuspended_pkgs }
3482     grep { $_->unsuspended_pkgs }
3483       $self->referral_cust_main($depth);
3484 }
3485
3486 =item referring_cust_main
3487
3488 Returns the single cust_main record for the customer who referred this customer
3489 (referral_custnum), or false.
3490
3491 =cut
3492
3493 sub referring_cust_main {
3494   my $self = shift;
3495   return '' unless $self->referral_custnum;
3496   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3497 }
3498
3499 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3500
3501 Applies a credit to this customer.  If there is an error, returns the error,
3502 otherwise returns false.
3503
3504 REASON can be a text string, an FS::reason object, or a scalar reference to
3505 a reasonnum.  If a text string, it will be automatically inserted as a new
3506 reason, and a 'reason_type' option must be passed to indicate the
3507 FS::reason_type for the new reason.
3508
3509 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3510
3511 Any other options are passed to FS::cust_credit::insert.
3512
3513 =cut
3514
3515 sub credit {
3516   my( $self, $amount, $reason, %options ) = @_;
3517
3518   my $cust_credit = new FS::cust_credit {
3519     'custnum' => $self->custnum,
3520     'amount'  => $amount,
3521   };
3522
3523   if ( ref($reason) ) {
3524
3525     if ( ref($reason) eq 'SCALAR' ) {
3526       $cust_credit->reasonnum( $$reason );
3527     } else {
3528       $cust_credit->reasonnum( $reason->reasonnum );
3529     }
3530
3531   } else {
3532     $cust_credit->set('reason', $reason)
3533   }
3534
3535   for (qw( addlinfo eventnum )) {
3536     $cust_credit->$_( delete $options{$_} )
3537       if exists($options{$_});
3538   }
3539
3540   $cust_credit->insert(%options);
3541
3542 }
3543
3544 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3545
3546 Creates a one-time charge for this customer.  If there is an error, returns
3547 the error, otherwise returns false.
3548
3549 New-style, with a hashref of options:
3550
3551   my $error = $cust_main->charge(
3552                                   {
3553                                     'amount'     => 54.32,
3554                                     'quantity'   => 1,
3555                                     'start_date' => str2time('7/4/2009'),
3556                                     'pkg'        => 'Description',
3557                                     'comment'    => 'Comment',
3558                                     'additional' => [], #extra invoice detail
3559                                     'classnum'   => 1,  #pkg_class
3560
3561                                     'setuptax'   => '', # or 'Y' for tax exempt
3562
3563                                     #internal taxation
3564                                     'taxclass'   => 'Tax class',
3565
3566                                     #vendor taxation
3567                                     'taxproduct' => 2,  #part_pkg_taxproduct
3568                                     'override'   => {}, #XXX describe
3569
3570                                     #will be filled in with the new object
3571                                     'cust_pkg_ref' => \$cust_pkg,
3572
3573                                     #generate an invoice immediately
3574                                     'bill_now' => 0,
3575                                     'invoice_terms' => '', #with these terms
3576                                   }
3577                                 );
3578
3579 Old-style:
3580
3581   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3582
3583 =cut
3584
3585 sub charge {
3586   my $self = shift;
3587   my ( $amount, $quantity, $start_date, $classnum );
3588   my ( $pkg, $comment, $additional );
3589   my ( $setuptax, $taxclass );   #internal taxes
3590   my ( $taxproduct, $override ); #vendor (CCH) taxes
3591   my $no_auto = '';
3592   my $cust_pkg_ref = '';
3593   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3594   if ( ref( $_[0] ) ) {
3595     $amount     = $_[0]->{amount};
3596     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3597     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3598     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3599     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3600     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3601                                            : '$'. sprintf("%.2f",$amount);
3602     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3603     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3604     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3605     $additional = $_[0]->{additional} || [];
3606     $taxproduct = $_[0]->{taxproductnum};
3607     $override   = { '' => $_[0]->{tax_override} };
3608     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3609     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3610     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3611   } else {
3612     $amount     = shift;
3613     $quantity   = 1;
3614     $start_date = '';
3615     $pkg        = @_ ? shift : 'One-time charge';
3616     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3617     $setuptax   = '';
3618     $taxclass   = @_ ? shift : '';
3619     $additional = [];
3620   }
3621
3622   local $SIG{HUP} = 'IGNORE';
3623   local $SIG{INT} = 'IGNORE';
3624   local $SIG{QUIT} = 'IGNORE';
3625   local $SIG{TERM} = 'IGNORE';
3626   local $SIG{TSTP} = 'IGNORE';
3627   local $SIG{PIPE} = 'IGNORE';
3628
3629   my $oldAutoCommit = $FS::UID::AutoCommit;
3630   local $FS::UID::AutoCommit = 0;
3631   my $dbh = dbh;
3632
3633   my $part_pkg = new FS::part_pkg ( {
3634     'pkg'           => $pkg,
3635     'comment'       => $comment,
3636     'plan'          => 'flat',
3637     'freq'          => 0,
3638     'disabled'      => 'Y',
3639     'classnum'      => ( $classnum ? $classnum : '' ),
3640     'setuptax'      => $setuptax,
3641     'taxclass'      => $taxclass,
3642     'taxproductnum' => $taxproduct,
3643   } );
3644
3645   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3646                         ( 0 .. @$additional - 1 )
3647                   ),
3648                   'additional_count' => scalar(@$additional),
3649                   'setup_fee' => $amount,
3650                 );
3651
3652   my $error = $part_pkg->insert( options       => \%options,
3653                                  tax_overrides => $override,
3654                                );
3655   if ( $error ) {
3656     $dbh->rollback if $oldAutoCommit;
3657     return $error;
3658   }
3659
3660   my $pkgpart = $part_pkg->pkgpart;
3661   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3662   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3663     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3664     $error = $type_pkgs->insert;
3665     if ( $error ) {
3666       $dbh->rollback if $oldAutoCommit;
3667       return $error;
3668     }
3669   }
3670
3671   my $cust_pkg = new FS::cust_pkg ( {
3672     'custnum'    => $self->custnum,
3673     'pkgpart'    => $pkgpart,
3674     'quantity'   => $quantity,
3675     'start_date' => $start_date,
3676     'no_auto'    => $no_auto,
3677   } );
3678
3679   $error = $cust_pkg->insert;
3680   if ( $error ) {
3681     $dbh->rollback if $oldAutoCommit;
3682     return $error;
3683   } elsif ( $cust_pkg_ref ) {
3684     ${$cust_pkg_ref} = $cust_pkg;
3685   }
3686
3687   if ( $bill_now ) {
3688     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3689                              'pkg_list'      => [ $cust_pkg ],
3690                            );
3691     if ( $error ) {
3692       $dbh->rollback if $oldAutoCommit;
3693       return $error;
3694     }
3695   }
3696
3697   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3698   return '';
3699
3700 }
3701
3702 #=item charge_postal_fee
3703 #
3704 #Applies a one time charge this customer.  If there is an error,
3705 #returns the error, returns the cust_pkg charge object or false
3706 #if there was no charge.
3707 #
3708 #=cut
3709 #
3710 # This should be a customer event.  For that to work requires that bill
3711 # also be a customer event.
3712
3713 sub charge_postal_fee {
3714   my $self = shift;
3715
3716   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart');
3717   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3718
3719   my $cust_pkg = new FS::cust_pkg ( {
3720     'custnum'  => $self->custnum,
3721     'pkgpart'  => $pkgpart,
3722     'quantity' => 1,
3723   } );
3724
3725   my $error = $cust_pkg->insert;
3726   $error ? $error : $cust_pkg;
3727 }
3728
3729 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3730
3731 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3732
3733 Optionally, a list or hashref of additional arguments to the qsearch call can
3734 be passed.
3735
3736 =cut
3737
3738 sub cust_bill {
3739   my $self = shift;
3740   my $opt = ref($_[0]) ? shift : { @_ };
3741
3742   #return $self->num_cust_bill unless wantarray || keys %$opt;
3743
3744   $opt->{'table'} = 'cust_bill';
3745   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3746   $opt->{'hashref'}{'custnum'} = $self->custnum;
3747   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3748
3749   map { $_ } #behavior of sort undefined in scalar context
3750     sort { $a->_date <=> $b->_date }
3751       qsearch($opt);
3752 }
3753
3754 =item open_cust_bill
3755
3756 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3757 customer.
3758
3759 =cut
3760
3761 sub open_cust_bill {
3762   my $self = shift;
3763
3764   $self->cust_bill(
3765     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3766     #@_
3767   );
3768
3769 }
3770
3771 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3772
3773 Returns all the statements (see L<FS::cust_statement>) for this customer.
3774
3775 Optionally, a list or hashref of additional arguments to the qsearch call can
3776 be passed.
3777
3778 =cut
3779
3780 sub cust_statement {
3781   my $self = shift;
3782   my $opt = ref($_[0]) ? shift : { @_ };
3783
3784   #return $self->num_cust_statement unless wantarray || keys %$opt;
3785
3786   $opt->{'table'} = 'cust_statement';
3787   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3788   $opt->{'hashref'}{'custnum'} = $self->custnum;
3789   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3790
3791   map { $_ } #behavior of sort undefined in scalar context
3792     sort { $a->_date <=> $b->_date }
3793       qsearch($opt);
3794 }
3795
3796 =item cust_credit
3797
3798 Returns all the credits (see L<FS::cust_credit>) for this customer.
3799
3800 =cut
3801
3802 sub cust_credit {
3803   my $self = shift;
3804   map { $_ } #return $self->num_cust_credit unless wantarray;
3805   sort { $a->_date <=> $b->_date }
3806     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3807 }
3808
3809 =item cust_credit_pkgnum
3810
3811 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3812 package when using experimental package balances.
3813
3814 =cut
3815
3816 sub cust_credit_pkgnum {
3817   my( $self, $pkgnum ) = @_;
3818   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3819   sort { $a->_date <=> $b->_date }
3820     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3821                               'pkgnum'  => $pkgnum,
3822                             }
3823     );
3824 }
3825
3826 =item cust_pay
3827
3828 Returns all the payments (see L<FS::cust_pay>) for this customer.
3829
3830 =cut
3831
3832 sub cust_pay {
3833   my $self = shift;
3834   return $self->num_cust_pay unless wantarray;
3835   sort { $a->_date <=> $b->_date }
3836     qsearch( 'cust_pay', { 'custnum' => $self->custnum } )
3837 }
3838
3839 =item num_cust_pay
3840
3841 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3842 called automatically when the cust_pay method is used in a scalar context.
3843
3844 =cut
3845
3846 sub num_cust_pay {
3847   my $self = shift;
3848   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3849   my $sth = dbh->prepare($sql) or die dbh->errstr;
3850   $sth->execute($self->custnum) or die $sth->errstr;
3851   $sth->fetchrow_arrayref->[0];
3852 }
3853
3854 =item cust_pay_pkgnum
3855
3856 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3857 package when using experimental package balances.
3858
3859 =cut
3860
3861 sub cust_pay_pkgnum {
3862   my( $self, $pkgnum ) = @_;
3863   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3864   sort { $a->_date <=> $b->_date }
3865     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3866                            'pkgnum'  => $pkgnum,
3867                          }
3868     );
3869 }
3870
3871 =item cust_pay_void
3872
3873 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3874
3875 =cut
3876
3877 sub cust_pay_void {
3878   my $self = shift;
3879   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3880   sort { $a->_date <=> $b->_date }
3881     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3882 }
3883
3884 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3885
3886 Returns all batched payments (see L<FS::cust_pay_void>) for this customer.
3887
3888 Optionally, a list or hashref of additional arguments to the qsearch call can
3889 be passed.
3890
3891 =cut
3892
3893 sub cust_pay_batch {
3894   my $self = shift;
3895   my $opt = ref($_[0]) ? shift : { @_ };
3896
3897   #return $self->num_cust_statement unless wantarray || keys %$opt;
3898
3899   $opt->{'table'} = 'cust_pay_batch';
3900   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3901   $opt->{'hashref'}{'custnum'} = $self->custnum;
3902   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3903
3904   map { $_ } #behavior of sort undefined in scalar context
3905     sort { $a->paybatchnum <=> $b->paybatchnum }
3906       qsearch($opt);
3907 }
3908
3909 =item cust_pay_pending
3910
3911 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3912 (without status "done").
3913
3914 =cut
3915
3916 sub cust_pay_pending {
3917   my $self = shift;
3918   return $self->num_cust_pay_pending unless wantarray;
3919   sort { $a->_date <=> $b->_date }
3920     qsearch( 'cust_pay_pending', {
3921                                    'custnum' => $self->custnum,
3922                                    'status'  => { op=>'!=', value=>'done' },
3923                                  },
3924            );
3925 }
3926
3927 =item cust_pay_pending_attempt
3928
3929 Returns all payment attempts / declined payments for this customer, as pending
3930 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3931 a corresponding payment (see L<FS::cust_pay>).
3932
3933 =cut
3934
3935 sub cust_pay_pending_attempt {
3936   my $self = shift;
3937   return $self->num_cust_pay_pending_attempt unless wantarray;
3938   sort { $a->_date <=> $b->_date }
3939     qsearch( 'cust_pay_pending', {
3940                                    'custnum' => $self->custnum,
3941                                    'status'  => 'done',
3942                                    'paynum'  => '',
3943                                  },
3944            );
3945 }
3946
3947 =item num_cust_pay_pending
3948
3949 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3950 customer (without status "done").  Also called automatically when the
3951 cust_pay_pending method is used in a scalar context.
3952
3953 =cut
3954
3955 sub num_cust_pay_pending {
3956   my $self = shift;
3957   $self->scalar_sql(
3958     " SELECT COUNT(*) FROM cust_pay_pending ".
3959       " WHERE custnum = ? AND status != 'done' ",
3960     $self->custnum
3961   );
3962 }
3963
3964 =item num_cust_pay_pending_attempt
3965
3966 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3967 customer, with status "done" but without a corresp.  Also called automatically when the
3968 cust_pay_pending method is used in a scalar context.
3969
3970 =cut
3971
3972 sub num_cust_pay_pending_attempt {
3973   my $self = shift;
3974   $self->scalar_sql(
3975     " SELECT COUNT(*) FROM cust_pay_pending ".
3976       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3977     $self->custnum
3978   );
3979 }
3980
3981 =item cust_refund
3982
3983 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3984
3985 =cut
3986
3987 sub cust_refund {
3988   my $self = shift;
3989   map { $_ } #return $self->num_cust_refund unless wantarray;
3990   sort { $a->_date <=> $b->_date }
3991     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3992 }
3993
3994 =item display_custnum
3995
3996 Returns the displayed customer number for this customer: agent_custid if
3997 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3998
3999 =cut
4000
4001 sub display_custnum {
4002   my $self = shift;
4003   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
4004     return $self->agent_custid;
4005   } else {
4006     return $self->custnum;
4007   }
4008 }
4009
4010 =item name
4011
4012 Returns a name string for this customer, either "Company (Last, First)" or
4013 "Last, First".
4014
4015 =cut
4016
4017 sub name {
4018   my $self = shift;
4019   my $name = $self->contact;
4020   $name = $self->company. " ($name)" if $self->company;
4021   $name;
4022 }
4023
4024 =item ship_name
4025
4026 Returns a name string for this (service/shipping) contact, either
4027 "Company (Last, First)" or "Last, First".
4028
4029 =cut
4030
4031 sub ship_name {
4032   my $self = shift;
4033   if ( $self->get('ship_last') ) {
4034     my $name = $self->ship_contact;
4035     $name = $self->ship_company. " ($name)" if $self->ship_company;
4036     $name;
4037   } else {
4038     $self->name;
4039   }
4040 }
4041
4042 =item name_short
4043
4044 Returns a name string for this customer, either "Company" or "First Last".
4045
4046 =cut
4047
4048 sub name_short {
4049   my $self = shift;
4050   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4051 }
4052
4053 =item ship_name_short
4054
4055 Returns a name string for this (service/shipping) contact, either "Company"
4056 or "First Last".
4057
4058 =cut
4059
4060 sub ship_name_short {
4061   my $self = shift;
4062   if ( $self->get('ship_last') ) {
4063     $self->ship_company !~ /^\s*$/
4064       ? $self->ship_company
4065       : $self->ship_contact_firstlast;
4066   } else {
4067     $self->name_company_or_firstlast;
4068   }
4069 }
4070
4071 =item contact
4072
4073 Returns this customer's full (billing) contact name only, "Last, First"
4074
4075 =cut
4076
4077 sub contact {
4078   my $self = shift;
4079   $self->get('last'). ', '. $self->first;
4080 }
4081
4082 =item ship_contact
4083
4084 Returns this customer's full (shipping) contact name only, "Last, First"
4085
4086 =cut
4087
4088 sub ship_contact {
4089   my $self = shift;
4090   $self->get('ship_last')
4091     ? $self->get('ship_last'). ', '. $self->ship_first
4092     : $self->contact;
4093 }
4094
4095 =item contact_firstlast
4096
4097 Returns this customers full (billing) contact name only, "First Last".
4098
4099 =cut
4100
4101 sub contact_firstlast {
4102   my $self = shift;
4103   $self->first. ' '. $self->get('last');
4104 }
4105
4106 =item ship_contact_firstlast
4107
4108 Returns this customer's full (shipping) contact name only, "First Last".
4109
4110 =cut
4111
4112 sub ship_contact_firstlast {
4113   my $self = shift;
4114   $self->get('ship_last')
4115     ? $self->first. ' '. $self->get('ship_last')
4116     : $self->contact_firstlast;
4117 }
4118
4119 =item country_full
4120
4121 Returns this customer's full country name
4122
4123 =cut
4124
4125 sub country_full {
4126   my $self = shift;
4127   code2country($self->country);
4128 }
4129
4130 =item geocode DATA_VENDOR
4131
4132 Returns a value for the customer location as encoded by DATA_VENDOR.
4133 Currently this only makes sense for "CCH" as DATA_VENDOR.
4134
4135 =cut
4136
4137 sub geocode {
4138   my ($self, $data_vendor) = (shift, shift);  #always cch for now
4139
4140   my $geocode = $self->get('geocode');  #XXX only one data_vendor for geocode
4141   return $geocode if $geocode;
4142
4143   my $prefix = ( $conf->exists('tax-ship_address') && length($self->ship_last) )
4144                ? 'ship_'
4145                : '';
4146
4147   my($zip,$plus4) = split /-/, $self->get("${prefix}zip")
4148     if $self->country eq 'US';
4149
4150   $zip ||= '';
4151   $plus4 ||= '';
4152   #CCH specific location stuff
4153   my $extra_sql = "AND plus4lo <= '$plus4' AND plus4hi >= '$plus4'";
4154
4155   my @cust_tax_location =
4156     qsearch( {
4157                'table'     => 'cust_tax_location',
4158                'hashref'   => { 'zip' => $zip, 'data_vendor' => $data_vendor },
4159                'extra_sql' => $extra_sql,
4160                'order_by'  => 'ORDER BY plus4hi',#overlapping with distinct ends
4161              }
4162            );
4163   $geocode = $cust_tax_location[0]->geocode
4164     if scalar(@cust_tax_location);
4165
4166   $geocode;
4167 }
4168
4169 =item cust_status
4170
4171 =item status
4172
4173 Returns a status string for this customer, currently:
4174
4175 =over 4
4176
4177 =item prospect - No packages have ever been ordered
4178
4179 =item ordered - Recurring packages all are new (not yet billed).
4180
4181 =item active - One or more recurring packages is active
4182
4183 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4184
4185 =item suspended - All non-cancelled recurring packages are suspended
4186
4187 =item cancelled - All recurring packages are cancelled
4188
4189 =back
4190
4191 =cut
4192
4193 sub status { shift->cust_status(@_); }
4194
4195 sub cust_status {
4196   my $self = shift;
4197   # prospect ordered active inactive suspended cancelled
4198   for my $status ( FS::cust_main->statuses() ) {
4199     my $method = $status.'_sql';
4200     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4201     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4202     $sth->execute( ($self->custnum) x $numnum )
4203       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4204     return $status if $sth->fetchrow_arrayref->[0];
4205   }
4206 }
4207
4208 =item ucfirst_cust_status
4209
4210 =item ucfirst_status
4211
4212 Returns the status with the first character capitalized.
4213
4214 =cut
4215
4216 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4217
4218 sub ucfirst_cust_status {
4219   my $self = shift;
4220   ucfirst($self->cust_status);
4221 }
4222
4223 =item statuscolor
4224
4225 Returns a hex triplet color string for this customer's status.
4226
4227 =cut
4228
4229 use vars qw(%statuscolor);
4230 tie %statuscolor, 'Tie::IxHash',
4231   'prospect'  => '7e0079', #'000000', #black?  naw, purple
4232   'active'    => '00CC00', #green
4233   'ordered'   => '009999', #teal? cyan?
4234   'inactive'  => '0000CC', #blue
4235   'suspended' => 'FF9900', #yellow
4236   'cancelled' => 'FF0000', #red
4237 ;
4238
4239 sub statuscolor { shift->cust_statuscolor(@_); }
4240
4241 sub cust_statuscolor {
4242   my $self = shift;
4243   $statuscolor{$self->cust_status};
4244 }
4245
4246 =item tickets
4247
4248 Returns an array of hashes representing the customer's RT tickets.
4249
4250 =cut
4251
4252 sub tickets {
4253   my $self = shift;
4254
4255   my $num = $conf->config('cust_main-max_tickets') || 10;
4256   my @tickets = ();
4257
4258   if ( $conf->config('ticket_system') ) {
4259     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4260
4261       @tickets = @{ FS::TicketSystem->customer_tickets($self->custnum, $num) };
4262
4263     } else {
4264
4265       foreach my $priority (
4266         $conf->config('ticket_system-custom_priority_field-values'), ''
4267       ) {
4268         last if scalar(@tickets) >= $num;
4269         push @tickets,
4270           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4271                                                  $num - scalar(@tickets),
4272                                                  $priority,
4273                                                )
4274            };
4275       }
4276     }
4277   }
4278   (@tickets);
4279 }
4280
4281 # Return services representing svc_accts in customer support packages
4282 sub support_services {
4283   my $self = shift;
4284   my %packages = map { $_ => 1 } $conf->config('support_packages');
4285
4286   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4287     grep { $_->part_svc->svcdb eq 'svc_acct' }
4288     map { $_->cust_svc }
4289     grep { exists $packages{ $_->pkgpart } }
4290     $self->ncancelled_pkgs;
4291
4292 }
4293
4294 # Return a list of latitude/longitude for one of the services (if any)
4295 sub service_coordinates {
4296   my $self = shift;
4297
4298   my @svc_X =
4299     grep { $_->latitude && $_->longitude }
4300     map { $_->svc_x }
4301     map { $_->cust_svc }
4302     $self->ncancelled_pkgs;
4303
4304   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4305 }
4306
4307 =item masked FIELD
4308
4309 Returns a masked version of the named field
4310
4311 =cut
4312
4313 sub masked {
4314 my ($self,$field) = @_;
4315
4316 # Show last four
4317
4318 'x'x(length($self->getfield($field))-4).
4319   substr($self->getfield($field), (length($self->getfield($field))-4));
4320
4321 }
4322
4323 =back
4324
4325 =head1 CLASS METHODS
4326
4327 =over 4
4328
4329 =item statuses
4330
4331 Class method that returns the list of possible status strings for customers
4332 (see L<the status method|/status>).  For example:
4333
4334   @statuses = FS::cust_main->statuses();
4335
4336 =cut
4337
4338 sub statuses {
4339   #my $self = shift; #could be class...
4340   keys %statuscolor;
4341 }
4342
4343 =item prospect_sql
4344
4345 Returns an SQL expression identifying prospective cust_main records (customers
4346 with no packages ever ordered)
4347
4348 =cut
4349
4350 use vars qw($select_count_pkgs);
4351 $select_count_pkgs =
4352   "SELECT COUNT(*) FROM cust_pkg
4353     WHERE cust_pkg.custnum = cust_main.custnum";
4354
4355 sub select_count_pkgs_sql {
4356   $select_count_pkgs;
4357 }
4358
4359 sub prospect_sql {
4360   " 0 = ( $select_count_pkgs ) ";
4361 }
4362
4363 =item ordered_sql
4364
4365 Returns an SQL expression identifying ordered cust_main records (customers with
4366 recurring packages not yet setup).
4367
4368 =cut
4369
4370 sub ordered_sql {
4371   FS::cust_main->none_active_sql.
4372   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->ordered_sql. " ) ";
4373 }
4374
4375 =item active_sql
4376
4377 Returns an SQL expression identifying active cust_main records (customers with
4378 active recurring packages).
4379
4380 =cut
4381
4382 sub active_sql {
4383   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4384 }
4385
4386 =item none_active_sql
4387
4388 Returns an SQL expression identifying cust_main records with no active
4389 recurring packages.  This includes customers of status prospect, ordered,
4390 inactive, and suspended.
4391
4392 =cut
4393
4394 sub none_active_sql {
4395   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4396 }
4397
4398 =item inactive_sql
4399
4400 Returns an SQL expression identifying inactive cust_main records (customers with
4401 no active recurring packages, but otherwise unsuspended/uncancelled).
4402
4403 =cut
4404
4405 sub inactive_sql {
4406   FS::cust_main->none_active_sql.
4407   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4408 }
4409
4410 =item susp_sql
4411 =item suspended_sql
4412
4413 Returns an SQL expression identifying suspended cust_main records.
4414
4415 =cut
4416
4417
4418 sub suspended_sql { susp_sql(@_); }
4419 sub susp_sql {
4420   FS::cust_main->none_active_sql.
4421   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4422 }
4423
4424 =item cancel_sql
4425 =item cancelled_sql
4426
4427 Returns an SQL expression identifying cancelled cust_main records.
4428
4429 =cut
4430
4431 sub cancelled_sql { cancel_sql(@_); }
4432 sub cancel_sql {
4433
4434   my $recurring_sql = FS::cust_pkg->recurring_sql;
4435   my $cancelled_sql = FS::cust_pkg->cancelled_sql;
4436
4437   "
4438         0 < ( $select_count_pkgs )
4439     AND 0 < ( $select_count_pkgs AND $recurring_sql AND $cancelled_sql   )
4440     AND 0 = ( $select_count_pkgs AND $recurring_sql
4441                   AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4442             )
4443     AND 0 = (  $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " )
4444   ";
4445
4446 }
4447
4448 =item uncancel_sql
4449 =item uncancelled_sql
4450
4451 Returns an SQL expression identifying un-cancelled cust_main records.
4452
4453 =cut
4454
4455 sub uncancelled_sql { uncancel_sql(@_); }
4456 sub uncancel_sql { "
4457   ( 0 < ( $select_count_pkgs
4458                    AND ( cust_pkg.cancel IS NULL
4459                          OR cust_pkg.cancel = 0
4460                        )
4461         )
4462     OR 0 = ( $select_count_pkgs )
4463   )
4464 "; }
4465
4466 =item balance_sql
4467
4468 Returns an SQL fragment to retreive the balance.
4469
4470 =cut
4471
4472 sub balance_sql { "
4473     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4474         WHERE cust_bill.custnum   = cust_main.custnum     )
4475   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4476         WHERE cust_pay.custnum    = cust_main.custnum     )
4477   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4478         WHERE cust_credit.custnum = cust_main.custnum     )
4479   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4480         WHERE cust_refund.custnum = cust_main.custnum     )
4481 "; }
4482
4483 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4484
4485 Returns an SQL fragment to retreive the balance for this customer, optionally
4486 considering invoices with date earlier than START_TIME, and not
4487 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4488 total_unapplied_payments).
4489
4490 Times are specified as SQL fragments or numeric
4491 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4492 L<Date::Parse> for conversion functions.  The empty string can be passed
4493 to disable that time constraint completely.
4494
4495 Available options are:
4496
4497 =over 4
4498
4499 =item unapplied_date
4500
4501 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)
4502
4503 =item total
4504
4505 (unused.  obsolete?)
4506 set to true to remove all customer comparison clauses, for totals
4507
4508 =item where
4509
4510 (unused.  obsolete?)
4511 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4512
4513 =item join
4514
4515 (unused.  obsolete?)
4516 JOIN clause (typically used with the total option)
4517
4518 =item cutoff
4519
4520 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4521 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4522 range for invoices and I<unapplied> payments, credits, and refunds.
4523
4524 =back
4525
4526 =cut
4527
4528 sub balance_date_sql {
4529   my( $class, $start, $end, %opt ) = @_;
4530
4531   my $cutoff = $opt{'cutoff'};
4532
4533   my $owed         = FS::cust_bill->owed_sql($cutoff);
4534   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4535   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4536   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4537
4538   my $j = $opt{'join'} || '';
4539
4540   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4541   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4542   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4543   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4544
4545   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4546     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4547     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4548     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4549   ";
4550
4551 }
4552
4553 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4554
4555 Returns an SQL fragment to retreive the total unapplied payments for this
4556 customer, only considering invoices with date earlier than START_TIME, and
4557 optionally not later than END_TIME.
4558
4559 Times are specified as SQL fragments or numeric
4560 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4561 L<Date::Parse> for conversion functions.  The empty string can be passed
4562 to disable that time constraint completely.
4563
4564 Available options are:
4565
4566 =cut
4567
4568 sub unapplied_payments_date_sql {
4569   my( $class, $start, $end, %opt ) = @_;
4570
4571   my $cutoff = $opt{'cutoff'};
4572
4573   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4574
4575   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4576                                                           'unapplied_date'=>1 );
4577
4578   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4579 }
4580
4581 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4582
4583 Helper method for balance_date_sql; name (and usage) subject to change
4584 (suggestions welcome).
4585
4586 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4587 cust_refund, cust_credit or cust_pay).
4588
4589 If TABLE is "cust_bill" or the unapplied_date option is true, only
4590 considers records with date earlier than START_TIME, and optionally not
4591 later than END_TIME .
4592
4593 =cut
4594
4595 sub _money_table_where {
4596   my( $class, $table, $start, $end, %opt ) = @_;
4597
4598   my @where = ();
4599   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4600   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4601     push @where, "$table._date <= $start" if defined($start) && length($start);
4602     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4603   }
4604   push @where, @{$opt{'where'}} if $opt{'where'};
4605   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4606
4607   $where;
4608
4609 }
4610
4611 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4612 use FS::cust_main::Search;
4613 sub search {
4614   my $class = shift;
4615   FS::cust_main::Search->search(@_);
4616 }
4617
4618 =back
4619
4620 =head1 SUBROUTINES
4621
4622 =over 4
4623
4624 =item append_fuzzyfiles FIRSTNAME LASTNAME COMPANY ADDRESS1
4625
4626 =cut
4627
4628 use FS::cust_main::Search;
4629 sub append_fuzzyfiles {
4630   #my( $first, $last, $company ) = @_;
4631
4632   FS::cust_main::Search::check_and_rebuild_fuzzyfiles();
4633
4634   use Fcntl qw(:flock);
4635
4636   my $dir = $FS::UID::conf_dir. "/cache.". $FS::UID::datasrc;
4637
4638   foreach my $field (@fuzzyfields) {
4639     my $value = shift;
4640
4641     if ( $value ) {
4642
4643       open(CACHE,">>$dir/cust_main.$field")
4644         or die "can't open $dir/cust_main.$field: $!";
4645       flock(CACHE,LOCK_EX)
4646         or die "can't lock $dir/cust_main.$field: $!";
4647
4648       print CACHE "$value\n";
4649
4650       flock(CACHE,LOCK_UN)
4651         or die "can't unlock $dir/cust_main.$field: $!";
4652       close CACHE;
4653     }
4654
4655   }
4656
4657   1;
4658 }
4659
4660 =item batch_charge
4661
4662 =cut
4663
4664 sub batch_charge {
4665   my $param = shift;
4666   #warn join('-',keys %$param);
4667   my $fh = $param->{filehandle};
4668   my $agentnum = $param->{agentnum};
4669   my $format = $param->{format};
4670
4671   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4672
4673   my @fields;
4674   if ( $format eq 'simple' ) {
4675     @fields = qw( custnum agent_custid amount pkg );
4676   } else {
4677     die "unknown format $format";
4678   }
4679
4680   eval "use Text::CSV_XS;";
4681   die $@ if $@;
4682
4683   my $csv = new Text::CSV_XS;
4684   #warn $csv;
4685   #warn $fh;
4686
4687   my $imported = 0;
4688   #my $columns;
4689
4690   local $SIG{HUP} = 'IGNORE';
4691   local $SIG{INT} = 'IGNORE';
4692   local $SIG{QUIT} = 'IGNORE';
4693   local $SIG{TERM} = 'IGNORE';
4694   local $SIG{TSTP} = 'IGNORE';
4695   local $SIG{PIPE} = 'IGNORE';
4696
4697   my $oldAutoCommit = $FS::UID::AutoCommit;
4698   local $FS::UID::AutoCommit = 0;
4699   my $dbh = dbh;
4700
4701   #while ( $columns = $csv->getline($fh) ) {
4702   my $line;
4703   while ( defined($line=<$fh>) ) {
4704
4705     $csv->parse($line) or do {
4706       $dbh->rollback if $oldAutoCommit;
4707       return "can't parse: ". $csv->error_input();
4708     };
4709
4710     my @columns = $csv->fields();
4711     #warn join('-',@columns);
4712
4713     my %row = ();
4714     foreach my $field ( @fields ) {
4715       $row{$field} = shift @columns;
4716     }
4717
4718     if ( $row{custnum} && $row{agent_custid} ) {
4719       dbh->rollback if $oldAutoCommit;
4720       return "can't specify custnum with agent_custid $row{agent_custid}";
4721     }
4722
4723     my %hash = ();
4724     if ( $row{agent_custid} && $agentnum ) {
4725       %hash = ( 'agent_custid' => $row{agent_custid},
4726                 'agentnum'     => $agentnum,
4727               );
4728     }
4729
4730     if ( $row{custnum} ) {
4731       %hash = ( 'custnum' => $row{custnum} );
4732     }
4733
4734     unless ( scalar(keys %hash) ) {
4735       $dbh->rollback if $oldAutoCommit;
4736       return "can't find customer without custnum or agent_custid and agentnum";
4737     }
4738
4739     my $cust_main = qsearchs('cust_main', { %hash } );
4740     unless ( $cust_main ) {
4741       $dbh->rollback if $oldAutoCommit;
4742       my $custnum = $row{custnum} || $row{agent_custid};
4743       return "unknown custnum $custnum";
4744     }
4745
4746     if ( $row{'amount'} > 0 ) {
4747       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4748       if ( $error ) {
4749         $dbh->rollback if $oldAutoCommit;
4750         return $error;
4751       }
4752       $imported++;
4753     } elsif ( $row{'amount'} < 0 ) {
4754       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4755                                       $row{'pkg'}                         );
4756       if ( $error ) {
4757         $dbh->rollback if $oldAutoCommit;
4758         return $error;
4759       }
4760       $imported++;
4761     } else {
4762       #hmm?
4763     }
4764
4765   }
4766
4767   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4768
4769   return "Empty file!" unless $imported;
4770
4771   ''; #no error
4772
4773 }
4774
4775 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4776
4777 Deprecated.  Use event notification and message templates
4778 (L<FS::msg_template>) instead.
4779
4780 Sends a templated email notification to the customer (see L<Text::Template>).
4781
4782 OPTIONS is a hash and may include
4783
4784 I<from> - the email sender (default is invoice_from)
4785
4786 I<to> - comma-separated scalar or arrayref of recipients
4787    (default is invoicing_list)
4788
4789 I<subject> - The subject line of the sent email notification
4790    (default is "Notice from company_name")
4791
4792 I<extra_fields> - a hashref of name/value pairs which will be substituted
4793    into the template
4794
4795 The following variables are vavailable in the template.
4796
4797 I<$first> - the customer first name
4798 I<$last> - the customer last name
4799 I<$company> - the customer company
4800 I<$payby> - a description of the method of payment for the customer
4801             # would be nice to use FS::payby::shortname
4802 I<$payinfo> - the account information used to collect for this customer
4803 I<$expdate> - the expiration of the customer payment in seconds from epoch
4804
4805 =cut
4806
4807 sub notify {
4808   my ($self, $template, %options) = @_;
4809
4810   return unless $conf->exists($template);
4811
4812   my $from = $conf->config('invoice_from', $self->agentnum)
4813     if $conf->exists('invoice_from', $self->agentnum);
4814   $from = $options{from} if exists($options{from});
4815
4816   my $to = join(',', $self->invoicing_list_emailonly);
4817   $to = $options{to} if exists($options{to});
4818
4819   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4820     if $conf->exists('company_name', $self->agentnum);
4821   $subject = $options{subject} if exists($options{subject});
4822
4823   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4824                                             SOURCE => [ map "$_\n",
4825                                               $conf->config($template)]
4826                                            )
4827     or die "can't create new Text::Template object: Text::Template::ERROR";
4828   $notify_template->compile()
4829     or die "can't compile template: Text::Template::ERROR";
4830
4831   $FS::notify_template::_template::company_name =
4832     $conf->config('company_name', $self->agentnum);
4833   $FS::notify_template::_template::company_address =
4834     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4835
4836   my $paydate = $self->paydate || '2037-12-31';
4837   $FS::notify_template::_template::first = $self->first;
4838   $FS::notify_template::_template::last = $self->last;
4839   $FS::notify_template::_template::company = $self->company;
4840   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4841   my $payby = $self->payby;
4842   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4843   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4844
4845   #credit cards expire at the end of the month/year of their exp date
4846   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4847     $FS::notify_template::_template::payby = 'credit card';
4848     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4849     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4850     $expire_time--;
4851   }elsif ($payby eq 'COMP') {
4852     $FS::notify_template::_template::payby = 'complimentary account';
4853   }else{
4854     $FS::notify_template::_template::payby = 'current method';
4855   }
4856   $FS::notify_template::_template::expdate = $expire_time;
4857
4858   for (keys %{$options{extra_fields}}){
4859     no strict "refs";
4860     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4861   }
4862
4863   send_email(from => $from,
4864              to => $to,
4865              subject => $subject,
4866              body => $notify_template->fill_in( PACKAGE =>
4867                                                 'FS::notify_template::_template'                                              ),
4868             );
4869
4870 }
4871
4872 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4873
4874 Generates a templated notification to the customer (see L<Text::Template>).
4875
4876 OPTIONS is a hash and may include
4877
4878 I<extra_fields> - a hashref of name/value pairs which will be substituted
4879    into the template.  These values may override values mentioned below
4880    and those from the customer record.
4881
4882 The following variables are available in the template instead of or in addition
4883 to the fields of the customer record.
4884
4885 I<$payby> - a description of the method of payment for the customer
4886             # would be nice to use FS::payby::shortname
4887 I<$payinfo> - the masked account information used to collect for this customer
4888 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4889 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4890
4891 =cut
4892
4893 # a lot like cust_bill::print_latex
4894 sub generate_letter {
4895   my ($self, $template, %options) = @_;
4896
4897   return unless $conf->exists($template);
4898
4899   my $letter_template = new Text::Template
4900                         ( TYPE       => 'ARRAY',
4901                           SOURCE     => [ map "$_\n", $conf->config($template)],
4902                           DELIMITERS => [ '[@--', '--@]' ],
4903                         )
4904     or die "can't create new Text::Template object: Text::Template::ERROR";
4905
4906   $letter_template->compile()
4907     or die "can't compile template: Text::Template::ERROR";
4908
4909   my %letter_data = map { $_ => $self->$_ } $self->fields;
4910   $letter_data{payinfo} = $self->mask_payinfo;
4911
4912   #my $paydate = $self->paydate || '2037-12-31';
4913   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4914
4915   my $payby = $self->payby;
4916   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4917   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4918
4919   #credit cards expire at the end of the month/year of their exp date
4920   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4921     $letter_data{payby} = 'credit card';
4922     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4923     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4924     $expire_time--;
4925   }elsif ($payby eq 'COMP') {
4926     $letter_data{payby} = 'complimentary account';
4927   }else{
4928     $letter_data{payby} = 'current method';
4929   }
4930   $letter_data{expdate} = $expire_time;
4931
4932   for (keys %{$options{extra_fields}}){
4933     $letter_data{$_} = $options{extra_fields}->{$_};
4934   }
4935
4936   unless(exists($letter_data{returnaddress})){
4937     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4938                                                   $self->agent_template)
4939                      );
4940     if ( length($retadd) ) {
4941       $letter_data{returnaddress} = $retadd;
4942     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4943       $letter_data{returnaddress} =
4944         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4945                           s/$/\\\\\*/;
4946                           $_;
4947                         }
4948                     ( $conf->config('company_name', $self->agentnum),
4949                       $conf->config('company_address', $self->agentnum),
4950                     )
4951         );
4952     } else {
4953       $letter_data{returnaddress} = '~';
4954     }
4955   }
4956
4957   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4958
4959   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4960
4961   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4962
4963   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4964                            DIR      => $dir,
4965                            SUFFIX   => '.eps',
4966                            UNLINK   => 0,
4967                          ) or die "can't open temp file: $!\n";
4968   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4969     or die "can't write temp file: $!\n";
4970   close $lh;
4971   $letter_data{'logo_file'} = $lh->filename;
4972
4973   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4974                            DIR      => $dir,
4975                            SUFFIX   => '.tex',
4976                            UNLINK   => 0,
4977                          ) or die "can't open temp file: $!\n";
4978
4979   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4980   close $fh;
4981   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4982   return ($1, $letter_data{'logo_file'});
4983
4984 }
4985
4986 =item print_ps TEMPLATE
4987
4988 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4989
4990 =cut
4991
4992 sub print_ps {
4993   my $self = shift;
4994   my($file, $lfile) = $self->generate_letter(@_);
4995   my $ps = FS::Misc::generate_ps($file);
4996   unlink($file.'.tex');
4997   unlink($lfile);
4998
4999   $ps;
5000 }
5001
5002 =item print TEMPLATE
5003
5004 Prints the filled in template.
5005
5006 TEMPLATE is the name of a L<Text::Template> to fill in and print.
5007
5008 =cut
5009
5010 sub queueable_print {
5011   my %opt = @_;
5012
5013   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5014     or die "invalid customer number: " . $opt{custvnum};
5015
5016   my $error = $self->print( $opt{template} );
5017   die $error if $error;
5018 }
5019
5020 sub print {
5021   my ($self, $template) = (shift, shift);
5022   do_print [ $self->print_ps($template) ];
5023 }
5024
5025 #these three subs should just go away once agent stuff is all config overrides
5026
5027 sub agent_template {
5028   my $self = shift;
5029   $self->_agent_plandata('agent_templatename');
5030 }
5031
5032 sub agent_invoice_from {
5033   my $self = shift;
5034   $self->_agent_plandata('agent_invoice_from');
5035 }
5036
5037 sub _agent_plandata {
5038   my( $self, $option ) = @_;
5039
5040   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
5041   #agent-specific Conf
5042
5043   use FS::part_event::Condition;
5044
5045   my $agentnum = $self->agentnum;
5046
5047   my $regexp = regexp_sql();
5048
5049   my $part_event_option =
5050     qsearchs({
5051       'select'    => 'part_event_option.*',
5052       'table'     => 'part_event_option',
5053       'addl_from' => q{
5054         LEFT JOIN part_event USING ( eventpart )
5055         LEFT JOIN part_event_option AS peo_agentnum
5056           ON ( part_event.eventpart = peo_agentnum.eventpart
5057                AND peo_agentnum.optionname = 'agentnum'
5058                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5059              )
5060         LEFT JOIN part_event_condition
5061           ON ( part_event.eventpart = part_event_condition.eventpart
5062                AND part_event_condition.conditionname = 'cust_bill_age'
5063              )
5064         LEFT JOIN part_event_condition_option
5065           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5066                AND part_event_condition_option.optionname = 'age'
5067              )
5068       },
5069       #'hashref'   => { 'optionname' => $option },
5070       #'hashref'   => { 'part_event_option.optionname' => $option },
5071       'extra_sql' =>
5072         " WHERE part_event_option.optionname = ". dbh->quote($option).
5073         " AND action = 'cust_bill_send_agent' ".
5074         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5075         " AND peo_agentnum.optionname = 'agentnum' ".
5076         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5077         " ORDER BY
5078            CASE WHEN part_event_condition_option.optionname IS NULL
5079            THEN -1
5080            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5081         " END
5082           , part_event.weight".
5083         " LIMIT 1"
5084     });
5085
5086   unless ( $part_event_option ) {
5087     return $self->agent->invoice_template || ''
5088       if $option eq 'agent_templatename';
5089     return '';
5090   }
5091
5092   $part_event_option->optionvalue;
5093
5094 }
5095
5096 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5097
5098 Subroutine (not a method), designed to be called from the queue.
5099
5100 Takes a list of options and values.
5101
5102 Pulls up the customer record via the custnum option and calls bill_and_collect.
5103
5104 =cut
5105
5106 sub queued_bill {
5107   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5108
5109   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5110   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5111
5112   $cust_main->bill_and_collect( %args );
5113 }
5114
5115 sub process_bill_and_collect {
5116   my $job = shift;
5117   my $param = thaw(decode_base64(shift));
5118   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5119       or die "custnum '$param->{custnum}' not found!\n";
5120   $param->{'job'}   = $job;
5121   $param->{'fatal'} = 1; # runs from job queue, will be caught
5122   $param->{'retry'} = 1;
5123
5124   $cust_main->bill_and_collect( %$param );
5125 }
5126
5127 sub _upgrade_data { #class method
5128   my ($class, %opts) = @_;
5129
5130   my $sql = 'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL';
5131   my $sth = dbh->prepare($sql) or die dbh->errstr;
5132   $sth->execute or die $sth->errstr;
5133
5134   local($ignore_expired_card) = 1;
5135   local($ignore_illegal_zip) = 1;
5136   local($ignore_illegal_zip) = 1;
5137   local($ignore_banned_card) = 1;
5138   $class->_upgrade_otaker(%opts);
5139
5140 }
5141
5142 =back
5143
5144 =head1 BUGS
5145
5146 The delete method.
5147
5148 The delete method should possibly take an FS::cust_main object reference
5149 instead of a scalar customer number.
5150
5151 Bill and collect options should probably be passed as references instead of a
5152 list.
5153
5154 There should probably be a configuration file with a list of allowed credit
5155 card types.
5156
5157 No multiple currency support (probably a larger project than just this module).
5158
5159 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5160
5161 Birthdates rely on negative epoch values.
5162
5163 The payby for card/check batches is broken.  With mixed batching, bad
5164 things will happen.
5165
5166 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5167
5168 =head1 SEE ALSO
5169
5170 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5171 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5172 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5173
5174 =cut
5175
5176 1;
5177