FS/FS/cust_main.pm

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