FS/FS/cust_main.pm

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