FS/FS/cust_main.pm

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