FS/FS/cust_main.pm

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