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