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