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.  Always returns a list: an empty list
2153 on success or a list of errors.
2154
2155 =cut
2156
2157 sub unsuspend {
2158   my $self = shift;
2159   grep { $_->unsuspend } $self->suspended_pkgs;
2160 }
2161
2162 =item suspend
2163
2164 Suspends all unsuspended packages (see L<FS::cust_pkg>) for this customer.
2165
2166 Returns a list: an empty list on success or a list of errors.
2167
2168 =cut
2169
2170 sub suspend {
2171   my $self = shift;
2172   grep { $_->suspend(@_) } $self->unsuspended_pkgs;
2173 }
2174
2175 =item suspend_if_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2176
2177 Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed
2178 PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref instead
2179 of a list of pkgparts; the hashref has the following keys:
2180
2181 =over 4
2182
2183 =item pkgparts - listref of pkgparts
2184
2185 =item (other options are passed to the suspend method)
2186
2187 =back
2188
2189
2190 Returns a list: an empty list on success or a list of errors.
2191
2192 =cut
2193
2194 sub suspend_if_pkgpart {
2195   my $self = shift;
2196   my (@pkgparts, %opt);
2197   if (ref($_[0]) eq 'HASH'){
2198     @pkgparts = @{$_[0]{pkgparts}};
2199     %opt      = %{$_[0]};
2200   }else{
2201     @pkgparts = @_;
2202   }
2203   grep { $_->suspend(%opt) }
2204     grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts }
2205       $self->unsuspended_pkgs;
2206 }
2207
2208 =item suspend_unless_pkgpart HASHREF | PKGPART [ , PKGPART ... ]
2209
2210 Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the
2211 given PKGPARTs (see L<FS::part_pkg>).  Preferred usage is to pass a hashref
2212 instead of a list of pkgparts; the hashref has the following keys:
2213
2214 =over 4
2215
2216 =item pkgparts - listref of pkgparts
2217
2218 =item (other options are passed to the suspend method)
2219
2220 =back
2221
2222 Returns a list: an empty list on success or a list of errors.
2223
2224 =cut
2225
2226 sub suspend_unless_pkgpart {
2227   my $self = shift;
2228   my (@pkgparts, %opt);
2229   if (ref($_[0]) eq 'HASH'){
2230     @pkgparts = @{$_[0]{pkgparts}};
2231     %opt      = %{$_[0]};
2232   }else{
2233     @pkgparts = @_;
2234   }
2235   grep { $_->suspend(%opt) }
2236     grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts }
2237       $self->unsuspended_pkgs;
2238 }
2239
2240 =item cancel [ OPTION => VALUE ... ]
2241
2242 Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer.
2243
2244 Available options are:
2245
2246 =over 4
2247
2248 =item quiet - can be set true to supress email cancellation notices.
2249
2250 =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.
2251
2252 =item ban - can be set true to ban this customer's credit card or ACH information, if present.
2253
2254 =item nobill - can be set true to skip billing if it might otherwise be done.
2255
2256 =back
2257
2258 Always returns a list: an empty list on success or a list of errors.
2259
2260 =cut
2261
2262 # nb that dates are not specified as valid options to this method
2263
2264 sub cancel {
2265   my( $self, %opt ) = @_;
2266
2267   warn "$me cancel called on customer ". $self->custnum. " with options ".
2268        join(', ', map { "$_: $opt{$_}" } keys %opt ). "\n"
2269     if $DEBUG;
2270
2271   return ( 'access denied' )
2272     unless $FS::CurrentUser::CurrentUser->access_right('Cancel customer');
2273
2274   if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) {
2275
2276     #should try decryption (we might have the private key)
2277     # and if not maybe queue a job for the server that does?
2278     return ( "Can't (yet) ban encrypted credit cards" )
2279       if $self->is_encrypted($self->payinfo);
2280
2281     my $ban = new FS::banned_pay $self->_new_banned_pay_hashref;
2282     my $error = $ban->insert;
2283     return ( $error ) if $error;
2284
2285   }
2286
2287   my @pkgs = $self->ncancelled_pkgs;
2288
2289   if ( !$opt{nobill} && $conf->exists('bill_usage_on_cancel') ) {
2290     $opt{nobill} = 1;
2291     my $error = $self->bill( pkg_list => [ @pkgs ], cancel => 1 );
2292     warn "Error billing during cancel, custnum ". $self->custnum. ": $error"
2293       if $error;
2294   }
2295
2296   warn "$me cancelling ". scalar($self->ncancelled_pkgs). "/".
2297        scalar(@pkgs). " packages for customer ". $self->custnum. "\n"
2298     if $DEBUG;
2299
2300   grep { $_ } map { $_->cancel(%opt) } $self->ncancelled_pkgs;
2301 }
2302
2303 sub _banned_pay_hashref {
2304   my $self = shift;
2305
2306   my %payby2ban = (
2307     'CARD' => 'CARD',
2308     'DCRD' => 'CARD',
2309     'CHEK' => 'CHEK',
2310     'DCHK' => 'CHEK'
2311   );
2312
2313   {
2314     'payby'   => $payby2ban{$self->payby},
2315     'payinfo' => $self->payinfo,
2316     #don't ever *search* on reason! #'reason'  =>
2317   };
2318 }
2319
2320 sub _new_banned_pay_hashref {
2321   my $self = shift;
2322   my $hr = $self->_banned_pay_hashref;
2323   $hr->{payinfo} = md5_base64($hr->{payinfo});
2324   $hr;
2325 }
2326
2327 =item notes
2328
2329 Returns all notes (see L<FS::cust_main_note>) for this customer.
2330
2331 =cut
2332
2333 sub notes {
2334   my($self,$orderby_classnum) = (shift,shift);
2335   my $orderby = "_DATE DESC";
2336   $orderby = "CLASSNUM ASC, $orderby" if $orderby_classnum;
2337   qsearch( 'cust_main_note',
2338            { 'custnum' => $self->custnum },
2339            '',
2340            "ORDER BY $orderby",
2341          );
2342 }
2343
2344 =item agent
2345
2346 Returns the agent (see L<FS::agent>) for this customer.
2347
2348 =cut
2349
2350 sub agent {
2351   my $self = shift;
2352   qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
2353 }
2354
2355 =item agent_name
2356
2357 Returns the agent name (see L<FS::agent>) for this customer.
2358
2359 =cut
2360
2361 sub agent_name {
2362   my $self = shift;
2363   $self->agent->agent;
2364 }
2365
2366 =item cust_tag
2367
2368 Returns any tags associated with this customer, as FS::cust_tag objects,
2369 or an empty list if there are no tags.
2370
2371 =cut
2372
2373 sub cust_tag {
2374   my $self = shift;
2375   qsearch('cust_tag', { 'custnum' => $self->custnum } );
2376 }
2377
2378 =item part_tag
2379
2380 Returns any tags associated with this customer, as FS::part_tag objects,
2381 or an empty list if there are no tags.
2382
2383 =cut
2384
2385 sub part_tag {
2386   my $self = shift;
2387   map $_->part_tag, $self->cust_tag;
2388 }
2389
2390
2391 =item cust_class
2392
2393 Returns the customer class, as an FS::cust_class object, or the empty string
2394 if there is no customer class.
2395
2396 =cut
2397
2398 sub cust_class {
2399   my $self = shift;
2400   if ( $self->classnum ) {
2401     qsearchs('cust_class', { 'classnum' => $self->classnum } );
2402   } else {
2403     return '';
2404   }
2405 }
2406
2407 =item categoryname
2408
2409 Returns the customer category name, or the empty string if there is no customer
2410 category.
2411
2412 =cut
2413
2414 sub categoryname {
2415   my $self = shift;
2416   my $cust_class = $self->cust_class;
2417   $cust_class
2418     ? $cust_class->categoryname
2419     : '';
2420 }
2421
2422 =item classname
2423
2424 Returns the customer class name, or the empty string if there is no customer
2425 class.
2426
2427 =cut
2428
2429 sub classname {
2430   my $self = shift;
2431   my $cust_class = $self->cust_class;
2432   $cust_class
2433     ? $cust_class->classname
2434     : '';
2435 }
2436
2437 =item BILLING METHODS
2438
2439 Documentation on billing methods has been moved to
2440 L<FS::cust_main::Billing>.
2441
2442 =item REALTIME BILLING METHODS
2443
2444 Documentation on realtime billing methods has been moved to
2445 L<FS::cust_main::Billing_Realtime>.
2446
2447 =item remove_cvv
2448
2449 Removes the I<paycvv> field from the database directly.
2450
2451 If there is an error, returns the error, otherwise returns false.
2452
2453 =cut
2454
2455 sub remove_cvv {
2456   my $self = shift;
2457   my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
2458     or return dbh->errstr;
2459   $sth->execute($self->custnum)
2460     or return $sth->errstr;
2461   $self->paycvv('');
2462   '';
2463 }
2464
2465 =item batch_card OPTION => VALUE...
2466
2467 Adds a payment for this invoice to the pending credit card batch (see
2468 L<FS::cust_pay_batch>), or, if the B<realtime> option is set to a true value,
2469 runs the payment using a realtime gateway.
2470
2471 Options may include:
2472
2473 B<amount>: the amount to be paid; defaults to the customer's balance minus
2474 any payments in transit.
2475
2476 B<payby>: the payment method; defaults to cust_main.payby
2477
2478 B<realtime>: runs this as a realtime payment instead of adding it to a
2479 batch.  Deprecated.
2480
2481 B<invnum>: sets cust_pay_batch.invnum.
2482
2483 B<address1>, B<address2>, B<city>, B<state>, B<zip>, B<country>: sets
2484 the billing address for the payment; defaults to the customer's billing
2485 location.
2486
2487 B<payinfo>, B<paydate>, B<payname>: sets the payment account, expiration
2488 date, and name; defaults to those fields in cust_main.
2489
2490 =cut
2491
2492 sub batch_card {
2493   my ($self, %options) = @_;
2494
2495   my $amount;
2496   if (exists($options{amount})) {
2497     $amount = $options{amount};
2498   }else{
2499     $amount = sprintf("%.2f", $self->balance - $self->in_transit_payments);
2500   }
2501   return '' unless $amount > 0;
2502
2503   my $invnum = delete $options{invnum};
2504   my $payby = $options{payby} || $self->payby;  #still dubious
2505
2506   if ($options{'realtime'}) {
2507     return $self->realtime_bop( FS::payby->payby2bop($self->payby),
2508                                 $amount,
2509                                 %options,
2510                               );
2511   }
2512
2513   my $oldAutoCommit = $FS::UID::AutoCommit;
2514   local $FS::UID::AutoCommit = 0;
2515   my $dbh = dbh;
2516
2517   #this needs to handle mysql as well as Pg, like svc_acct.pm
2518   #(make it into a common function if folks need to do batching with mysql)
2519   $dbh->do("LOCK TABLE pay_batch IN SHARE ROW EXCLUSIVE MODE")
2520     or return "Cannot lock pay_batch: " . $dbh->errstr;
2521
2522   my %pay_batch = (
2523     'status' => 'O',
2524     'payby'  => FS::payby->payby2payment($payby),
2525   );
2526   $pay_batch{agentnum} = $self->agentnum if $conf->exists('batch-spoolagent');
2527
2528   my $pay_batch = qsearchs( 'pay_batch', \%pay_batch );
2529
2530   unless ( $pay_batch ) {
2531     $pay_batch = new FS::pay_batch \%pay_batch;
2532     my $error = $pay_batch->insert;
2533     if ( $error ) {
2534       $dbh->rollback if $oldAutoCommit;
2535       die "error creating new batch: $error\n";
2536     }
2537   }
2538
2539   my $old_cust_pay_batch = qsearchs('cust_pay_batch', {
2540       'batchnum' => $pay_batch->batchnum,
2541       'custnum'  => $self->custnum,
2542   } );
2543
2544   foreach (qw( address1 address2 city state zip country latitude longitude
2545                payby payinfo paydate payname ))
2546   {
2547     $options{$_} = '' unless exists($options{$_});
2548   }
2549
2550   my $loc = $self->bill_location;
2551
2552   my $cust_pay_batch = new FS::cust_pay_batch ( {
2553     'batchnum' => $pay_batch->batchnum,
2554     'invnum'   => $invnum || 0,                    # is there a better value?
2555                                                    # this field should be
2556                                                    # removed...
2557                                                    # cust_bill_pay_batch now
2558     'custnum'  => $self->custnum,
2559     'last'     => $self->getfield('last'),
2560     'first'    => $self->getfield('first'),
2561     'address1' => $options{address1} || $loc->address1,
2562     'address2' => $options{address2} || $loc->address2,
2563     'city'     => $options{city}     || $loc->city,
2564     'state'    => $options{state}    || $loc->state,
2565     'zip'      => $options{zip}      || $loc->zip,
2566     'country'  => $options{country}  || $loc->country,
2567     'payby'    => $options{payby}    || $self->payby,
2568     'payinfo'  => $options{payinfo}  || $self->payinfo,
2569     'exp'      => $options{paydate}  || $self->paydate,
2570     'payname'  => $options{payname}  || $self->payname,
2571     'amount'   => $amount,                         # consolidating
2572   } );
2573
2574   $cust_pay_batch->paybatchnum($old_cust_pay_batch->paybatchnum)
2575     if $old_cust_pay_batch;
2576
2577   my $error;
2578   if ($old_cust_pay_batch) {
2579     $error = $cust_pay_batch->replace($old_cust_pay_batch)
2580   } else {
2581     $error = $cust_pay_batch->insert;
2582   }
2583
2584   if ( $error ) {
2585     $dbh->rollback if $oldAutoCommit;
2586     die $error;
2587   }
2588
2589   my $unapplied =   $self->total_unapplied_credits
2590                   + $self->total_unapplied_payments
2591                   + $self->in_transit_payments;
2592   foreach my $cust_bill ($self->open_cust_bill) {
2593     #$dbh->commit or die $dbh->errstr if $oldAutoCommit;
2594     my $cust_bill_pay_batch = new FS::cust_bill_pay_batch {
2595       'invnum' => $cust_bill->invnum,
2596       'paybatchnum' => $cust_pay_batch->paybatchnum,
2597       'amount' => $cust_bill->owed,
2598       '_date' => time,
2599     };
2600     if ($unapplied >= $cust_bill_pay_batch->amount){
2601       $unapplied -= $cust_bill_pay_batch->amount;
2602       next;
2603     }else{
2604       $cust_bill_pay_batch->amount(sprintf ( "%.2f",
2605                                    $cust_bill_pay_batch->amount - $unapplied ));      $unapplied = 0;
2606     }
2607     $error = $cust_bill_pay_batch->insert;
2608     if ( $error ) {
2609       $dbh->rollback if $oldAutoCommit;
2610       die $error;
2611     }
2612   }
2613
2614   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2615   '';
2616 }
2617
2618 =item total_owed
2619
2620 Returns the total owed for this customer on all invoices
2621 (see L<FS::cust_bill/owed>).
2622
2623 =cut
2624
2625 sub total_owed {
2626   my $self = shift;
2627   $self->total_owed_date(2145859200); #12/31/2037
2628 }
2629
2630 =item total_owed_date TIME
2631
2632 Returns the total owed for this customer on all invoices with date earlier than
2633 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2634 see L<Time::Local> and L<Date::Parse> for conversion functions.
2635
2636 =cut
2637
2638 sub total_owed_date {
2639   my $self = shift;
2640   my $time = shift;
2641
2642   my $custnum = $self->custnum;
2643
2644   my $owed_sql = FS::cust_bill->owed_sql;
2645
2646   my $sql = "
2647     SELECT SUM($owed_sql) FROM cust_bill
2648       WHERE custnum = $custnum
2649         AND _date <= $time
2650   ";
2651
2652   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2653
2654 }
2655
2656 =item total_owed_pkgnum PKGNUM
2657
2658 Returns the total owed on all invoices for this customer's specific package
2659 when using experimental package balances (see L<FS::cust_bill/owed_pkgnum>).
2660
2661 =cut
2662
2663 sub total_owed_pkgnum {
2664   my( $self, $pkgnum ) = @_;
2665   $self->total_owed_date_pkgnum(2145859200, $pkgnum); #12/31/2037
2666 }
2667
2668 =item total_owed_date_pkgnum TIME PKGNUM
2669
2670 Returns the total owed for this customer's specific package when using
2671 experimental package balances on all invoices with date earlier than
2672 TIME.  TIME is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also
2673 see L<Time::Local> and L<Date::Parse> for conversion functions.
2674
2675 =cut
2676
2677 sub total_owed_date_pkgnum {
2678   my( $self, $time, $pkgnum ) = @_;
2679
2680   my $total_bill = 0;
2681   foreach my $cust_bill (
2682     grep { $_->_date <= $time }
2683       qsearch('cust_bill', { 'custnum' => $self->custnum, } )
2684   ) {
2685     $total_bill += $cust_bill->owed_pkgnum($pkgnum);
2686   }
2687   sprintf( "%.2f", $total_bill );
2688
2689 }
2690
2691 =item total_paid
2692
2693 Returns the total amount of all payments.
2694
2695 =cut
2696
2697 sub total_paid {
2698   my $self = shift;
2699   my $total = 0;
2700   $total += $_->paid foreach $self->cust_pay;
2701   sprintf( "%.2f", $total );
2702 }
2703
2704 =item total_unapplied_credits
2705
2706 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2707 customer.  See L<FS::cust_credit/credited>.
2708
2709 =item total_credited
2710
2711 Old name for total_unapplied_credits.  Don't use.
2712
2713 =cut
2714
2715 sub total_credited {
2716   #carp "total_credited deprecated, use total_unapplied_credits";
2717   shift->total_unapplied_credits(@_);
2718 }
2719
2720 sub total_unapplied_credits {
2721   my $self = shift;
2722
2723   my $custnum = $self->custnum;
2724
2725   my $unapplied_sql = FS::cust_credit->unapplied_sql;
2726
2727   my $sql = "
2728     SELECT SUM($unapplied_sql) FROM cust_credit
2729       WHERE custnum = $custnum
2730   ";
2731
2732   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2733
2734 }
2735
2736 =item total_unapplied_credits_pkgnum PKGNUM
2737
2738 Returns the total outstanding credit (see L<FS::cust_credit>) for this
2739 customer.  See L<FS::cust_credit/credited>.
2740
2741 =cut
2742
2743 sub total_unapplied_credits_pkgnum {
2744   my( $self, $pkgnum ) = @_;
2745   my $total_credit = 0;
2746   $total_credit += $_->credited foreach $self->cust_credit_pkgnum($pkgnum);
2747   sprintf( "%.2f", $total_credit );
2748 }
2749
2750
2751 =item total_unapplied_payments
2752
2753 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer.
2754 See L<FS::cust_pay/unapplied>.
2755
2756 =cut
2757
2758 sub total_unapplied_payments {
2759   my $self = shift;
2760
2761   my $custnum = $self->custnum;
2762
2763   my $unapplied_sql = FS::cust_pay->unapplied_sql;
2764
2765   my $sql = "
2766     SELECT SUM($unapplied_sql) FROM cust_pay
2767       WHERE custnum = $custnum
2768   ";
2769
2770   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2771
2772 }
2773
2774 =item total_unapplied_payments_pkgnum PKGNUM
2775
2776 Returns the total unapplied payments (see L<FS::cust_pay>) for this customer's
2777 specific package when using experimental package balances.  See
2778 L<FS::cust_pay/unapplied>.
2779
2780 =cut
2781
2782 sub total_unapplied_payments_pkgnum {
2783   my( $self, $pkgnum ) = @_;
2784   my $total_unapplied = 0;
2785   $total_unapplied += $_->unapplied foreach $self->cust_pay_pkgnum($pkgnum);
2786   sprintf( "%.2f", $total_unapplied );
2787 }
2788
2789
2790 =item total_unapplied_refunds
2791
2792 Returns the total unrefunded refunds (see L<FS::cust_refund>) for this
2793 customer.  See L<FS::cust_refund/unapplied>.
2794
2795 =cut
2796
2797 sub total_unapplied_refunds {
2798   my $self = shift;
2799   my $custnum = $self->custnum;
2800
2801   my $unapplied_sql = FS::cust_refund->unapplied_sql;
2802
2803   my $sql = "
2804     SELECT SUM($unapplied_sql) FROM cust_refund
2805       WHERE custnum = $custnum
2806   ";
2807
2808   sprintf( "%.2f", $self->scalar_sql($sql) || 0 );
2809
2810 }
2811
2812 =item balance
2813
2814 Returns the balance for this customer (total_owed plus total_unrefunded, minus
2815 total_unapplied_credits minus total_unapplied_payments).
2816
2817 =cut
2818
2819 sub balance {
2820   my $self = shift;
2821   $self->balance_date_range;
2822 }
2823
2824 =item balance_date TIME
2825
2826 Returns the balance for this customer, only considering invoices with date
2827 earlier than TIME (total_owed_date minus total_credited minus
2828 total_unapplied_payments).  TIME is specified as a UNIX timestamp; see
2829 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
2830 functions.
2831
2832 =cut
2833
2834 sub balance_date {
2835   my $self = shift;
2836   $self->balance_date_range(shift);
2837 }
2838
2839 =item balance_date_range [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
2840
2841 Returns the balance for this customer, optionally considering invoices with
2842 date earlier than START_TIME, and not later than END_TIME
2843 (total_owed_date minus total_unapplied_credits minus total_unapplied_payments).
2844
2845 Times are specified as SQL fragments or numeric
2846 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
2847 L<Date::Parse> for conversion functions.  The empty string can be passed
2848 to disable that time constraint completely.
2849
2850 Accepts the same options as L<balance_date_sql>:
2851
2852 =over 4
2853
2854 =item unapplied_date
2855
2856 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)
2857
2858 =item cutoff
2859
2860 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
2861 time will be ignored.  Note that START_TIME and END_TIME only limit the date
2862 range for invoices and I<unapplied> payments, credits, and refunds.
2863
2864 =back
2865
2866 =cut
2867
2868 sub balance_date_range {
2869   my $self = shift;
2870   my $sql = 'SELECT SUM('. $self->balance_date_sql(@_).
2871             ') FROM cust_main WHERE custnum='. $self->custnum;
2872   sprintf( '%.2f', $self->scalar_sql($sql) || 0 );
2873 }
2874
2875 =item balance_pkgnum PKGNUM
2876
2877 Returns the balance for this customer's specific package when using
2878 experimental package balances (total_owed plus total_unrefunded, minus
2879 total_unapplied_credits minus total_unapplied_payments)
2880
2881 =cut
2882
2883 sub balance_pkgnum {
2884   my( $self, $pkgnum ) = @_;
2885
2886   sprintf( "%.2f",
2887       $self->total_owed_pkgnum($pkgnum)
2888 # n/a - refunds aren't part of pkg-balances since they don't apply to invoices
2889 #    + $self->total_unapplied_refunds_pkgnum($pkgnum)
2890     - $self->total_unapplied_credits_pkgnum($pkgnum)
2891     - $self->total_unapplied_payments_pkgnum($pkgnum)
2892   );
2893 }
2894
2895 =item in_transit_payments
2896
2897 Returns the total of requests for payments for this customer pending in
2898 batches in transit to the bank.  See L<FS::pay_batch> and L<FS::cust_pay_batch>
2899
2900 =cut
2901
2902 sub in_transit_payments {
2903   my $self = shift;
2904   my $in_transit_payments = 0;
2905   foreach my $pay_batch ( qsearch('pay_batch', {
2906     'status' => 'I',
2907   } ) ) {
2908     foreach my $cust_pay_batch ( qsearch('cust_pay_batch', {
2909       'batchnum' => $pay_batch->batchnum,
2910       'custnum' => $self->custnum,
2911     } ) ) {
2912       $in_transit_payments += $cust_pay_batch->amount;
2913     }
2914   }
2915   sprintf( "%.2f", $in_transit_payments );
2916 }
2917
2918 =item payment_info
2919
2920 Returns a hash of useful information for making a payment.
2921
2922 =over 4
2923
2924 =item balance
2925
2926 Current balance.
2927
2928 =item payby
2929
2930 'CARD' (credit card - automatic), 'DCRD' (credit card - on-demand),
2931 'CHEK' (electronic check - automatic), 'DCHK' (electronic check - on-demand),
2932 'LECB' (Phone bill billing), 'BILL' (billing), or 'COMP' (free).
2933
2934 =back
2935
2936 For credit card transactions:
2937
2938 =over 4
2939
2940 =item card_type 1
2941
2942 =item payname
2943
2944 Exact name on card
2945
2946 =back
2947
2948 For electronic check transactions:
2949
2950 =over 4
2951
2952 =item stateid_state
2953
2954 =back
2955
2956 =cut
2957
2958 sub payment_info {
2959   my $self = shift;
2960
2961   my %return = ();
2962
2963   $return{balance} = $self->balance;
2964
2965   $return{payname} = $self->payname
2966                      || ( $self->first. ' '. $self->get('last') );
2967
2968   $return{$_} = $self->bill_location->$_
2969     for qw(address1 address2 city state zip);
2970
2971   $return{payby} = $self->payby;
2972   $return{stateid_state} = $self->stateid_state;
2973
2974   if ( $self->payby =~ /^(CARD|DCRD)$/ ) {
2975     $return{card_type} = cardtype($self->payinfo);
2976     $return{payinfo} = $self->paymask;
2977
2978     @return{'month', 'year'} = $self->paydate_monthyear;
2979
2980   }
2981
2982   if ( $self->payby =~ /^(CHEK|DCHK)$/ ) {
2983     my ($payinfo1, $payinfo2) = split '@', $self->paymask;
2984     $return{payinfo1} = $payinfo1;
2985     $return{payinfo2} = $payinfo2;
2986     $return{paytype}  = $self->paytype;
2987     $return{paystate} = $self->paystate;
2988
2989   }
2990
2991   #doubleclick protection
2992   my $_date = time;
2993   $return{paybatch} = "webui-MyAccount-$_date-$$-". rand() * 2**32;
2994
2995   %return;
2996
2997 }
2998
2999 =item paydate_monthyear
3000
3001 Returns a two-element list consisting of the month and year of this customer's
3002 paydate (credit card expiration date for CARD customers)
3003
3004 =cut
3005
3006 sub paydate_monthyear {
3007   my $self = shift;
3008   if ( $self->paydate  =~ /^(\d{4})-(\d{1,2})-\d{1,2}$/ ) { #Pg date format
3009     ( $2, $1 );
3010   } elsif ( $self->paydate =~ /^(\d{1,2})-(\d{1,2}-)?(\d{4}$)/ ) {
3011     ( $1, $3 );
3012   } else {
3013     ('', '');
3014   }
3015 }
3016
3017 =item paydate_epoch
3018
3019 Returns the exact time in seconds corresponding to the payment method
3020 expiration date.  For CARD/DCRD customers this is the end of the month;
3021 for others (COMP is the only other payby that uses paydate) it's the start.
3022 Returns 0 if the paydate is empty or set to the far future.
3023
3024 =cut
3025
3026 sub paydate_epoch {
3027   my $self = shift;
3028   my ($month, $year) = $self->paydate_monthyear;
3029   return 0 if !$year or $year >= 2037;
3030   if ( $self->payby eq 'CARD' or $self->payby eq 'DCRD' ) {
3031     $month++;
3032     if ( $month == 13 ) {
3033       $month = 1;
3034       $year++;
3035     }
3036     return timelocal(0,0,0,1,$month-1,$year) - 1;
3037   }
3038   else {
3039     return timelocal(0,0,0,1,$month-1,$year);
3040   }
3041 }
3042
3043 =item paydate_epoch_sql
3044
3045 Class method.  Returns an SQL expression to obtain the payment expiration date
3046 as a number of seconds.
3047
3048 =cut
3049
3050 # Special expiration date behavior for non-CARD/DCRD customers has been
3051 # carefully preserved.  Do we really use that?
3052 sub paydate_epoch_sql {
3053   my $class = shift;
3054   my $table = shift || 'cust_main';
3055   my ($case1, $case2);
3056   if ( driver_name eq 'Pg' ) {
3057     $case1 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) + INTERVAL '1 month') - 1";
3058     $case2 = "EXTRACT( EPOCH FROM CAST( $table.paydate AS TIMESTAMP ) )";
3059   }
3060   elsif ( lc(driver_name) eq 'mysql' ) {
3061     $case1 = "UNIX_TIMESTAMP( DATE_ADD( CAST( $table.paydate AS DATETIME ), INTERVAL 1 month ) ) - 1";
3062     $case2 = "UNIX_TIMESTAMP( CAST( $table.paydate AS DATETIME ) )";
3063   }
3064   else { return '' }
3065   return "CASE WHEN $table.payby IN('CARD','DCRD')
3066   THEN ($case1)
3067   ELSE ($case2)
3068   END"
3069 }
3070
3071 =item tax_exemption TAXNAME
3072
3073 =cut
3074
3075 sub tax_exemption {
3076   my( $self, $taxname ) = @_;
3077
3078   qsearchs( 'cust_main_exemption', { 'custnum' => $self->custnum,
3079                                      'taxname' => $taxname,
3080                                    },
3081           );
3082 }
3083
3084 =item cust_main_exemption
3085
3086 =cut
3087
3088 sub cust_main_exemption {
3089   my $self = shift;
3090   qsearch( 'cust_main_exemption', { 'custnum' => $self->custnum } );
3091 }
3092
3093 =item invoicing_list [ ARRAYREF ]
3094
3095 If an arguement is given, sets these email addresses as invoice recipients
3096 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
3097 (except as warnings), so use check_invoicing_list first.
3098
3099 Returns a list of email addresses (with svcnum entries expanded).
3100
3101 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
3102 check it without disturbing anything by passing nothing.
3103
3104 This interface may change in the future.
3105
3106 =cut
3107
3108 sub invoicing_list {
3109   my( $self, $arrayref ) = @_;
3110
3111   if ( $arrayref ) {
3112     my @cust_main_invoice;
3113     if ( $self->custnum ) {
3114       @cust_main_invoice =
3115         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3116     } else {
3117       @cust_main_invoice = ();
3118     }
3119     foreach my $cust_main_invoice ( @cust_main_invoice ) {
3120       #warn $cust_main_invoice->destnum;
3121       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
3122         #warn $cust_main_invoice->destnum;
3123         my $error = $cust_main_invoice->delete;
3124         warn $error if $error;
3125       }
3126     }
3127     if ( $self->custnum ) {
3128       @cust_main_invoice =
3129         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3130     } else {
3131       @cust_main_invoice = ();
3132     }
3133     my %seen = map { $_->address => 1 } @cust_main_invoice;
3134     foreach my $address ( @{$arrayref} ) {
3135       next if exists $seen{$address} && $seen{$address};
3136       $seen{$address} = 1;
3137       my $cust_main_invoice = new FS::cust_main_invoice ( {
3138         'custnum' => $self->custnum,
3139         'dest'    => $address,
3140       } );
3141       my $error = $cust_main_invoice->insert;
3142       warn $error if $error;
3143     }
3144   }
3145
3146   if ( $self->custnum ) {
3147     map { $_->address }
3148       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
3149   } else {
3150     ();
3151   }
3152
3153 }
3154
3155 =item check_invoicing_list ARRAYREF
3156
3157 Checks these arguements as valid input for the invoicing_list method.  If there
3158 is an error, returns the error, otherwise returns false.
3159
3160 =cut
3161
3162 sub check_invoicing_list {
3163   my( $self, $arrayref ) = @_;
3164
3165   foreach my $address ( @$arrayref ) {
3166
3167     if ($address eq 'FAX' and $self->getfield('fax') eq '') {
3168       return 'Can\'t add FAX invoice destination with a blank FAX number.';
3169     }
3170
3171     my $cust_main_invoice = new FS::cust_main_invoice ( {
3172       'custnum' => $self->custnum,
3173       'dest'    => $address,
3174     } );
3175     my $error = $self->custnum
3176                 ? $cust_main_invoice->check
3177                 : $cust_main_invoice->checkdest
3178     ;
3179     return $error if $error;
3180
3181   }
3182
3183   return "Email address required"
3184     if $conf->exists('cust_main-require_invoicing_list_email', $self->agentnum)
3185     && ! grep { $_ !~ /^([A-Z]+)$/ } @$arrayref;
3186
3187   '';
3188 }
3189
3190 =item set_default_invoicing_list
3191
3192 Sets the invoicing list to all accounts associated with this customer,
3193 overwriting any previous invoicing list.
3194
3195 =cut
3196
3197 sub set_default_invoicing_list {
3198   my $self = shift;
3199   $self->invoicing_list($self->all_emails);
3200 }
3201
3202 =item all_emails
3203
3204 Returns the email addresses of all accounts provisioned for this customer.
3205
3206 =cut
3207
3208 sub all_emails {
3209   my $self = shift;
3210   my %list;
3211   foreach my $cust_pkg ( $self->all_pkgs ) {
3212     my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } );
3213     my @svc_acct =
3214       map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3215         grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
3216           @cust_svc;
3217     $list{$_}=1 foreach map { $_->email } @svc_acct;
3218   }
3219   keys %list;
3220 }
3221
3222 =item invoicing_list_addpost
3223
3224 Adds postal invoicing to this customer.  If this customer is already configured
3225 to receive postal invoices, does nothing.
3226
3227 =cut
3228
3229 sub invoicing_list_addpost {
3230   my $self = shift;
3231   return if grep { $_ eq 'POST' } $self->invoicing_list;
3232   my @invoicing_list = $self->invoicing_list;
3233   push @invoicing_list, 'POST';
3234   $self->invoicing_list(\@invoicing_list);
3235 }
3236
3237 =item invoicing_list_emailonly
3238
3239 Returns the list of email invoice recipients (invoicing_list without non-email
3240 destinations such as POST and FAX).
3241
3242 =cut
3243
3244 sub invoicing_list_emailonly {
3245   my $self = shift;
3246   warn "$me invoicing_list_emailonly called"
3247     if $DEBUG;
3248   grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list;
3249 }
3250
3251 =item invoicing_list_emailonly_scalar
3252
3253 Returns the list of email invoice recipients (invoicing_list without non-email
3254 destinations such as POST and FAX) as a comma-separated scalar.
3255
3256 =cut
3257
3258 sub invoicing_list_emailonly_scalar {
3259   my $self = shift;
3260   warn "$me invoicing_list_emailonly_scalar called"
3261     if $DEBUG;
3262   join(', ', $self->invoicing_list_emailonly);
3263 }
3264
3265 =item referral_custnum_cust_main
3266
3267 Returns the customer who referred this customer (or the empty string, if
3268 this customer was not referred).
3269
3270 Note the difference with referral_cust_main method: This method,
3271 referral_custnum_cust_main returns the single customer (if any) who referred
3272 this customer, while referral_cust_main returns an array of customers referred
3273 BY this customer.
3274
3275 =cut
3276
3277 sub referral_custnum_cust_main {
3278   my $self = shift;
3279   return '' unless $self->referral_custnum;
3280   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3281 }
3282
3283 =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ]
3284
3285 Returns an array of customers referred by this customer (referral_custnum set
3286 to this custnum).  If DEPTH is given, recurses up to the given depth, returning
3287 customers referred by customers referred by this customer and so on, inclusive.
3288 The default behavior is DEPTH 1 (no recursion).
3289
3290 Note the difference with referral_custnum_cust_main method: This method,
3291 referral_cust_main, returns an array of customers referred BY this customer,
3292 while referral_custnum_cust_main returns the single customer (if any) who
3293 referred this customer.
3294
3295 =cut
3296
3297 sub referral_cust_main {
3298   my $self = shift;
3299   my $depth = @_ ? shift : 1;
3300   my $exclude = @_ ? shift : {};
3301
3302   my @cust_main =
3303     map { $exclude->{$_->custnum}++; $_; }
3304       grep { ! $exclude->{ $_->custnum } }
3305         qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } );
3306
3307   if ( $depth > 1 ) {
3308     push @cust_main,
3309       map { $_->referral_cust_main($depth-1, $exclude) }
3310         @cust_main;
3311   }
3312
3313   @cust_main;
3314 }
3315
3316 =item referral_cust_main_ncancelled
3317
3318 Same as referral_cust_main, except only returns customers with uncancelled
3319 packages.
3320
3321 =cut
3322
3323 sub referral_cust_main_ncancelled {
3324   my $self = shift;
3325   grep { scalar($_->ncancelled_pkgs) } $self->referral_cust_main;
3326 }
3327
3328 =item referral_cust_pkg [ DEPTH ]
3329
3330 Like referral_cust_main, except returns a flat list of all unsuspended (and
3331 uncancelled) packages for each customer.  The number of items in this list may
3332 be useful for commission calculations (perhaps after a C<grep { my $pkgpart = $_->pkgpart; grep { $_ == $pkgpart } @commission_worthy_pkgparts> } $cust_main-> ).
3333
3334 =cut
3335
3336 sub referral_cust_pkg {
3337   my $self = shift;
3338   my $depth = @_ ? shift : 1;
3339
3340   map { $_->unsuspended_pkgs }
3341     grep { $_->unsuspended_pkgs }
3342       $self->referral_cust_main($depth);
3343 }
3344
3345 =item referring_cust_main
3346
3347 Returns the single cust_main record for the customer who referred this customer
3348 (referral_custnum), or false.
3349
3350 =cut
3351
3352 sub referring_cust_main {
3353   my $self = shift;
3354   return '' unless $self->referral_custnum;
3355   qsearchs('cust_main', { 'custnum' => $self->referral_custnum } );
3356 }
3357
3358 =item credit AMOUNT, REASON [ , OPTION => VALUE ... ]
3359
3360 Applies a credit to this customer.  If there is an error, returns the error,
3361 otherwise returns false.
3362
3363 REASON can be a text string, an FS::reason object, or a scalar reference to
3364 a reasonnum.  If a text string, it will be automatically inserted as a new
3365 reason, and a 'reason_type' option must be passed to indicate the
3366 FS::reason_type for the new reason.
3367
3368 An I<addlinfo> option may be passed to set the credit's I<addlinfo> field.
3369 Likewise for I<eventnum>, I<commission_agentnum>, I<commission_salesnum> and
3370 I<commission_pkgnum>.
3371
3372 Any other options are passed to FS::cust_credit::insert.
3373
3374 =cut
3375
3376 sub credit {
3377   my( $self, $amount, $reason, %options ) = @_;
3378
3379   my $cust_credit = new FS::cust_credit {
3380     'custnum' => $self->custnum,
3381     'amount'  => $amount,
3382   };
3383
3384   if ( ref($reason) ) {
3385
3386     if ( ref($reason) eq 'SCALAR' ) {
3387       $cust_credit->reasonnum( $$reason );
3388     } else {
3389       $cust_credit->reasonnum( $reason->reasonnum );
3390     }
3391
3392   } else {
3393     $cust_credit->set('reason', $reason)
3394   }
3395
3396   $cust_credit->$_( delete $options{$_} )
3397     foreach grep exists($options{$_}),
3398               qw( addlinfo eventnum ),
3399               map "commission_$_", qw( agentnum salesnum pkgnum );
3400
3401   $cust_credit->insert(%options);
3402
3403 }
3404
3405 =item charge HASHREF || AMOUNT [ PKG [ COMMENT [ TAXCLASS ] ] ]
3406
3407 Creates a one-time charge for this customer.  If there is an error, returns
3408 the error, otherwise returns false.
3409
3410 New-style, with a hashref of options:
3411
3412   my $error = $cust_main->charge(
3413                                   {
3414                                     'amount'     => 54.32,
3415                                     'quantity'   => 1,
3416                                     'start_date' => str2time('7/4/2009'),
3417                                     'pkg'        => 'Description',
3418                                     'comment'    => 'Comment',
3419                                     'additional' => [], #extra invoice detail
3420                                     'classnum'   => 1,  #pkg_class
3421
3422                                     'setuptax'   => '', # or 'Y' for tax exempt
3423
3424                                     'locationnum'=> 1234, # optional
3425
3426                                     #internal taxation
3427                                     'taxclass'   => 'Tax class',
3428
3429                                     #vendor taxation
3430                                     'taxproduct' => 2,  #part_pkg_taxproduct
3431                                     'override'   => {}, #XXX describe
3432
3433                                     #will be filled in with the new object
3434                                     'cust_pkg_ref' => \$cust_pkg,
3435
3436                                     #generate an invoice immediately
3437                                     'bill_now' => 0,
3438                                     'invoice_terms' => '', #with these terms
3439                                   }
3440                                 );
3441
3442 Old-style:
3443
3444   my $error = $cust_main->charge( 54.32, 'Description', 'Comment', 'Tax class' );
3445
3446 =cut
3447
3448 sub charge {
3449   my $self = shift;
3450   my ( $amount, $quantity, $start_date, $classnum );
3451   my ( $pkg, $comment, $additional );
3452   my ( $setuptax, $taxclass );   #internal taxes
3453   my ( $taxproduct, $override ); #vendor (CCH) taxes
3454   my $no_auto = '';
3455   my $cust_pkg_ref = '';
3456   my ( $bill_now, $invoice_terms ) = ( 0, '' );
3457   my $locationnum;
3458   if ( ref( $_[0] ) ) {
3459     $amount     = $_[0]->{amount};
3460     $quantity   = exists($_[0]->{quantity}) ? $_[0]->{quantity} : 1;
3461     $start_date = exists($_[0]->{start_date}) ? $_[0]->{start_date} : '';
3462     $no_auto    = exists($_[0]->{no_auto}) ? $_[0]->{no_auto} : '';
3463     $pkg        = exists($_[0]->{pkg}) ? $_[0]->{pkg} : 'One-time charge';
3464     $comment    = exists($_[0]->{comment}) ? $_[0]->{comment}
3465                                            : '$'. sprintf("%.2f",$amount);
3466     $setuptax   = exists($_[0]->{setuptax}) ? $_[0]->{setuptax} : '';
3467     $taxclass   = exists($_[0]->{taxclass}) ? $_[0]->{taxclass} : '';
3468     $classnum   = exists($_[0]->{classnum}) ? $_[0]->{classnum} : '';
3469     $additional = $_[0]->{additional} || [];
3470     $taxproduct = $_[0]->{taxproductnum};
3471     $override   = { '' => $_[0]->{tax_override} };
3472     $cust_pkg_ref = exists($_[0]->{cust_pkg_ref}) ? $_[0]->{cust_pkg_ref} : '';
3473     $bill_now = exists($_[0]->{bill_now}) ? $_[0]->{bill_now} : '';
3474     $invoice_terms = exists($_[0]->{invoice_terms}) ? $_[0]->{invoice_terms} : '';
3475     $locationnum = $_[0]->{locationnum} || $self->ship_locationnum;
3476   } else {
3477     $amount     = shift;
3478     $quantity   = 1;
3479     $start_date = '';
3480     $pkg        = @_ ? shift : 'One-time charge';
3481     $comment    = @_ ? shift : '$'. sprintf("%.2f",$amount);
3482     $setuptax   = '';
3483     $taxclass   = @_ ? shift : '';
3484     $additional = [];
3485   }
3486
3487   local $SIG{HUP} = 'IGNORE';
3488   local $SIG{INT} = 'IGNORE';
3489   local $SIG{QUIT} = 'IGNORE';
3490   local $SIG{TERM} = 'IGNORE';
3491   local $SIG{TSTP} = 'IGNORE';
3492   local $SIG{PIPE} = 'IGNORE';
3493
3494   my $oldAutoCommit = $FS::UID::AutoCommit;
3495   local $FS::UID::AutoCommit = 0;
3496   my $dbh = dbh;
3497
3498   my $part_pkg = new FS::part_pkg ( {
3499     'pkg'           => $pkg,
3500     'comment'       => $comment,
3501     'plan'          => 'flat',
3502     'freq'          => 0,
3503     'disabled'      => 'Y',
3504     'classnum'      => ( $classnum ? $classnum : '' ),
3505     'setuptax'      => $setuptax,
3506     'taxclass'      => $taxclass,
3507     'taxproductnum' => $taxproduct,
3508   } );
3509
3510   my %options = ( ( map { ("additional_info$_" => $additional->[$_] ) }
3511                         ( 0 .. @$additional - 1 )
3512                   ),
3513                   'additional_count' => scalar(@$additional),
3514                   'setup_fee' => $amount,
3515                 );
3516
3517   my $error = $part_pkg->insert( options       => \%options,
3518                                  tax_overrides => $override,
3519                                );
3520   if ( $error ) {
3521     $dbh->rollback if $oldAutoCommit;
3522     return $error;
3523   }
3524
3525   my $pkgpart = $part_pkg->pkgpart;
3526   my %type_pkgs = ( 'typenum' => $self->agent->typenum, 'pkgpart' => $pkgpart );
3527   unless ( qsearchs('type_pkgs', \%type_pkgs ) ) {
3528     my $type_pkgs = new FS::type_pkgs \%type_pkgs;
3529     $error = $type_pkgs->insert;
3530     if ( $error ) {
3531       $dbh->rollback if $oldAutoCommit;
3532       return $error;
3533     }
3534   }
3535
3536   my $cust_pkg = new FS::cust_pkg ( {
3537     'custnum'    => $self->custnum,
3538     'pkgpart'    => $pkgpart,
3539     'quantity'   => $quantity,
3540     'start_date' => $start_date,
3541     'no_auto'    => $no_auto,
3542     'locationnum'=> $locationnum,
3543   } );
3544
3545   $error = $cust_pkg->insert;
3546   if ( $error ) {
3547     $dbh->rollback if $oldAutoCommit;
3548     return $error;
3549   } elsif ( $cust_pkg_ref ) {
3550     ${$cust_pkg_ref} = $cust_pkg;
3551   }
3552
3553   if ( $bill_now ) {
3554     my $error = $self->bill( 'invoice_terms' => $invoice_terms,
3555                              'pkg_list'      => [ $cust_pkg ],
3556                            );
3557     if ( $error ) {
3558       $dbh->rollback if $oldAutoCommit;
3559       return $error;
3560     }
3561   }
3562
3563   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3564   return '';
3565
3566 }
3567
3568 #=item charge_postal_fee
3569 #
3570 #Applies a one time charge this customer.  If there is an error,
3571 #returns the error, returns the cust_pkg charge object or false
3572 #if there was no charge.
3573 #
3574 #=cut
3575 #
3576 # This should be a customer event.  For that to work requires that bill
3577 # also be a customer event.
3578
3579 sub charge_postal_fee {
3580   my $self = shift;
3581
3582   my $pkgpart = $conf->config('postal_invoice-fee_pkgpart', $self->agentnum);
3583   return '' unless ($pkgpart && grep { $_ eq 'POST' } $self->invoicing_list);
3584
3585   my $cust_pkg = new FS::cust_pkg ( {
3586     'custnum'  => $self->custnum,
3587     'pkgpart'  => $pkgpart,
3588     'quantity' => 1,
3589   } );
3590
3591   my $error = $cust_pkg->insert;
3592   $error ? $error : $cust_pkg;
3593 }
3594
3595 =item cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3596
3597 Returns all the invoices (see L<FS::cust_bill>) for this customer.
3598
3599 Optionally, a list or hashref of additional arguments to the qsearch call can
3600 be passed.
3601
3602 =cut
3603
3604 sub cust_bill {
3605   my $self = shift;
3606   my $opt = ref($_[0]) ? shift : { @_ };
3607
3608   #return $self->num_cust_bill unless wantarray || keys %$opt;
3609
3610   $opt->{'table'} = 'cust_bill';
3611   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3612   $opt->{'hashref'}{'custnum'} = $self->custnum;
3613   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3614
3615   map { $_ } #behavior of sort undefined in scalar context
3616     sort { $a->_date <=> $b->_date }
3617       qsearch($opt);
3618 }
3619
3620 =item open_cust_bill
3621
3622 Returns all the open (owed > 0) invoices (see L<FS::cust_bill>) for this
3623 customer.
3624
3625 =cut
3626
3627 sub open_cust_bill {
3628   my $self = shift;
3629
3630   $self->cust_bill(
3631     'extra_sql' => ' AND '. FS::cust_bill->owed_sql. ' > 0',
3632     #@_
3633   );
3634
3635 }
3636
3637 =item legacy_cust_bill [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3638
3639 Returns all the legacy invoices (see L<FS::legacy_cust_bill>) for this customer.
3640
3641 =cut
3642
3643 sub legacy_cust_bill {
3644   my $self = shift;
3645
3646   #return $self->num_legacy_cust_bill unless wantarray;
3647
3648   map { $_ } #behavior of sort undefined in scalar context
3649     sort { $a->_date <=> $b->_date }
3650       qsearch({ 'table'    => 'legacy_cust_bill',
3651                 'hashref'  => { 'custnum' => $self->custnum, },
3652                 'order_by' => 'ORDER BY _date ASC',
3653              });
3654 }
3655
3656 =item cust_statement [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3657
3658 Returns all the statements (see L<FS::cust_statement>) for this customer.
3659
3660 Optionally, a list or hashref of additional arguments to the qsearch call can
3661 be passed.
3662
3663 =cut
3664
3665 =item cust_bill_void
3666
3667 Returns all the voided invoices (see L<FS::cust_bill_void>) for this customer.
3668
3669 =cut
3670
3671 sub cust_bill_void {
3672   my $self = shift;
3673
3674   map { $_ } #return $self->num_cust_bill_void unless wantarray;
3675   sort { $a->_date <=> $b->_date }
3676     qsearch( 'cust_bill_void', { 'custnum' => $self->custnum } )
3677 }
3678
3679 sub cust_statement {
3680   my $self = shift;
3681   my $opt = ref($_[0]) ? shift : { @_ };
3682
3683   #return $self->num_cust_statement unless wantarray || keys %$opt;
3684
3685   $opt->{'table'} = 'cust_statement';
3686   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3687   $opt->{'hashref'}{'custnum'} = $self->custnum;
3688   $opt->{'order_by'} ||= 'ORDER BY _date ASC';
3689
3690   map { $_ } #behavior of sort undefined in scalar context
3691     sort { $a->_date <=> $b->_date }
3692       qsearch($opt);
3693 }
3694
3695 =item svc_x SVCDB [ OPTION => VALUE | EXTRA_QSEARCH_PARAMS_HASHREF ]
3696
3697 Returns all services of type SVCDB (such as 'svc_acct') for this customer.
3698
3699 Optionally, a list or hashref of additional arguments to the qsearch call can
3700 be passed following the SVCDB.
3701
3702 =cut
3703
3704 sub svc_x {
3705   my $self = shift;
3706   my $svcdb = shift;
3707   if ( ! $svcdb =~ /^svc_\w+$/ ) {
3708     warn "$me svc_x requires a svcdb";
3709     return;
3710   }
3711   my $opt = ref($_[0]) ? shift : { @_ };
3712
3713   $opt->{'table'} = $svcdb;
3714   $opt->{'addl_from'} =
3715     'LEFT JOIN cust_svc USING (svcnum) LEFT JOIN cust_pkg USING (pkgnum) '.
3716     ($opt->{'addl_from'} || '');
3717
3718   my $custnum = $self->custnum;
3719   $custnum =~ /^\d+$/ or die "bad custnum '$custnum'";
3720   my $where = "cust_pkg.custnum = $custnum";
3721
3722   my $extra_sql = $opt->{'extra_sql'} || '';
3723   if ( keys %{ $opt->{'hashref'} } ) {
3724     $extra_sql = " AND $where $extra_sql";
3725   }
3726   else {
3727     if ( $opt->{'extra_sql'} =~ /^\s*where\s(.*)/si ) {
3728       $extra_sql = "WHERE $where AND $1";
3729     }
3730     else {
3731       $extra_sql = "WHERE $where $extra_sql";
3732     }
3733   }
3734   $opt->{'extra_sql'} = $extra_sql;
3735
3736   qsearch($opt);
3737 }
3738
3739 # required for use as an eventtable;
3740 sub svc_acct {
3741   my $self = shift;
3742   $self->svc_x('svc_acct', @_);
3743 }
3744
3745 =item cust_credit
3746
3747 Returns all the credits (see L<FS::cust_credit>) for this customer.
3748
3749 =cut
3750
3751 sub cust_credit {
3752   my $self = shift;
3753   map { $_ } #return $self->num_cust_credit unless wantarray;
3754   sort { $a->_date <=> $b->_date }
3755     qsearch( 'cust_credit', { 'custnum' => $self->custnum } )
3756 }
3757
3758 =item cust_credit_pkgnum
3759
3760 Returns all the credits (see L<FS::cust_credit>) for this customer's specific
3761 package when using experimental package balances.
3762
3763 =cut
3764
3765 sub cust_credit_pkgnum {
3766   my( $self, $pkgnum ) = @_;
3767   map { $_ } #return $self->num_cust_credit_pkgnum($pkgnum) unless wantarray;
3768   sort { $a->_date <=> $b->_date }
3769     qsearch( 'cust_credit', { 'custnum' => $self->custnum,
3770                               'pkgnum'  => $pkgnum,
3771                             }
3772     );
3773 }
3774
3775 =item cust_credit_void
3776
3777 Returns all voided credits (see L<FS::cust_credit_void>) for this customer.
3778
3779 =cut
3780
3781 sub cust_credit_void {
3782   my $self = shift;
3783   map { $_ }
3784   sort { $a->_date <=> $b->_date }
3785     qsearch( 'cust_credit_void', { 'custnum' => $self->custnum } )
3786 }
3787
3788 =item cust_pay
3789
3790 Returns all the payments (see L<FS::cust_pay>) for this customer.
3791
3792 =cut
3793
3794 sub cust_pay {
3795   my $self = shift;
3796   my $opt = ref($_[0]) ? shift : { @_ };
3797
3798   return $self->num_cust_pay unless wantarray || keys %$opt;
3799
3800   $opt->{'table'} = 'cust_pay';
3801   $opt->{'hashref'}{'custnum'} = $self->custnum;
3802
3803   map { $_ } #behavior of sort undefined in scalar context
3804     sort { $a->_date <=> $b->_date }
3805       qsearch($opt);
3806
3807 }
3808
3809 =item num_cust_pay
3810
3811 Returns the number of payments (see L<FS::cust_pay>) for this customer.  Also
3812 called automatically when the cust_pay method is used in a scalar context.
3813
3814 =cut
3815
3816 sub num_cust_pay {
3817   my $self = shift;
3818   my $sql = "SELECT COUNT(*) FROM cust_pay WHERE custnum = ?";
3819   my $sth = dbh->prepare($sql) or die dbh->errstr;
3820   $sth->execute($self->custnum) or die $sth->errstr;
3821   $sth->fetchrow_arrayref->[0];
3822 }
3823
3824 =item unapplied_cust_pay
3825
3826 Returns all the unapplied payments (see L<FS::cust_pay>) for this customer.
3827
3828 =cut
3829
3830 sub unapplied_cust_pay {
3831   my $self = shift;
3832
3833   $self->cust_pay(
3834     'extra_sql' => ' AND '. FS::cust_pay->unapplied_sql. ' > 0',
3835     #@_
3836   );
3837
3838 }
3839
3840 =item cust_pay_pkgnum
3841
3842 Returns all the payments (see L<FS::cust_pay>) for this customer's specific
3843 package when using experimental package balances.
3844
3845 =cut
3846
3847 sub cust_pay_pkgnum {
3848   my( $self, $pkgnum ) = @_;
3849   map { $_ } #return $self->num_cust_pay_pkgnum($pkgnum) unless wantarray;
3850   sort { $a->_date <=> $b->_date }
3851     qsearch( 'cust_pay', { 'custnum' => $self->custnum,
3852                            'pkgnum'  => $pkgnum,
3853                          }
3854     );
3855 }
3856
3857 =item cust_pay_void
3858
3859 Returns all voided payments (see L<FS::cust_pay_void>) for this customer.
3860
3861 =cut
3862
3863 sub cust_pay_void {
3864   my $self = shift;
3865   map { $_ } #return $self->num_cust_pay_void unless wantarray;
3866   sort { $a->_date <=> $b->_date }
3867     qsearch( 'cust_pay_void', { 'custnum' => $self->custnum } )
3868 }
3869
3870 =item cust_pay_batch [ OPTION => VALUE... | EXTRA_QSEARCH_PARAMS_HASHREF ]
3871
3872 Returns all batched payments (see L<FS::cust_pay_batch>) for this customer.
3873
3874 Optionally, a list or hashref of additional arguments to the qsearch call can
3875 be passed.
3876
3877 =cut
3878
3879 sub cust_pay_batch {
3880   my $self = shift;
3881   my $opt = ref($_[0]) ? shift : { @_ };
3882
3883   #return $self->num_cust_statement unless wantarray || keys %$opt;
3884
3885   $opt->{'table'} = 'cust_pay_batch';
3886   $opt->{'hashref'} ||= {}; #i guess it would autovivify anyway...
3887   $opt->{'hashref'}{'custnum'} = $self->custnum;
3888   $opt->{'order_by'} ||= 'ORDER BY paybatchnum ASC';
3889
3890   map { $_ } #behavior of sort undefined in scalar context
3891     sort { $a->paybatchnum <=> $b->paybatchnum }
3892       qsearch($opt);
3893 }
3894
3895 =item cust_pay_pending
3896
3897 Returns all pending payments (see L<FS::cust_pay_pending>) for this customer
3898 (without status "done").
3899
3900 =cut
3901
3902 sub cust_pay_pending {
3903   my $self = shift;
3904   return $self->num_cust_pay_pending unless wantarray;
3905   sort { $a->_date <=> $b->_date }
3906     qsearch( 'cust_pay_pending', {
3907                                    'custnum' => $self->custnum,
3908                                    'status'  => { op=>'!=', value=>'done' },
3909                                  },
3910            );
3911 }
3912
3913 =item cust_pay_pending_attempt
3914
3915 Returns all payment attempts / declined payments for this customer, as pending
3916 payments objects (see L<FS::cust_pay_pending>), with status "done" but without
3917 a corresponding payment (see L<FS::cust_pay>).
3918
3919 =cut
3920
3921 sub cust_pay_pending_attempt {
3922   my $self = shift;
3923   return $self->num_cust_pay_pending_attempt unless wantarray;
3924   sort { $a->_date <=> $b->_date }
3925     qsearch( 'cust_pay_pending', {
3926                                    'custnum' => $self->custnum,
3927                                    'status'  => 'done',
3928                                    'paynum'  => '',
3929                                  },
3930            );
3931 }
3932
3933 =item num_cust_pay_pending
3934
3935 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3936 customer (without status "done").  Also called automatically when the
3937 cust_pay_pending method is used in a scalar context.
3938
3939 =cut
3940
3941 sub num_cust_pay_pending {
3942   my $self = shift;
3943   $self->scalar_sql(
3944     " SELECT COUNT(*) FROM cust_pay_pending ".
3945       " WHERE custnum = ? AND status != 'done' ",
3946     $self->custnum
3947   );
3948 }
3949
3950 =item num_cust_pay_pending_attempt
3951
3952 Returns the number of pending payments (see L<FS::cust_pay_pending>) for this
3953 customer, with status "done" but without a corresp.  Also called automatically when the
3954 cust_pay_pending method is used in a scalar context.
3955
3956 =cut
3957
3958 sub num_cust_pay_pending_attempt {
3959   my $self = shift;
3960   $self->scalar_sql(
3961     " SELECT COUNT(*) FROM cust_pay_pending ".
3962       " WHERE custnum = ? AND status = 'done' AND paynum IS NULL",
3963     $self->custnum
3964   );
3965 }
3966
3967 =item cust_refund
3968
3969 Returns all the refunds (see L<FS::cust_refund>) for this customer.
3970
3971 =cut
3972
3973 sub cust_refund {
3974   my $self = shift;
3975   map { $_ } #return $self->num_cust_refund unless wantarray;
3976   sort { $a->_date <=> $b->_date }
3977     qsearch( 'cust_refund', { 'custnum' => $self->custnum } )
3978 }
3979
3980 =item display_custnum
3981
3982 Returns the displayed customer number for this customer: agent_custid if
3983 cust_main-default_agent_custid is set and it has a value, custnum otherwise.
3984
3985 =cut
3986
3987 sub display_custnum {
3988   my $self = shift;
3989
3990   my $prefix = $conf->config('cust_main-custnum-display_prefix', $self->agentnum) || '';
3991   if ( my $special = $conf->config('cust_main-custnum-display_special') ) {
3992     if ( $special eq 'CoStAg' ) {
3993       $prefix = uc( join('',
3994         $self->country,
3995         ($self->state =~ /^(..)/),
3996         $prefix || ($self->agent->agent =~ /^(..)/)
3997       ) );
3998     }
3999     elsif ( $special eq 'CoStCl' ) {
4000       $prefix = uc( join('',
4001         $self->country,
4002         ($self->state =~ /^(..)/),
4003         ($self->classnum ? $self->cust_class->classname =~ /^(..)/ : '__')
4004       ) );
4005     }
4006     # add any others here if needed
4007   }
4008
4009   my $length = $conf->config('cust_main-custnum-display_length');
4010   if ( $conf->exists('cust_main-default_agent_custid') && $self->agent_custid ){
4011     return $self->agent_custid;
4012   } elsif ( $prefix ) {
4013     $length = 8 if !defined($length);
4014     return $prefix .
4015            sprintf('%0'.$length.'d', $self->custnum)
4016   } elsif ( $length ) {
4017     return sprintf('%0'.$length.'d', $self->custnum);
4018   } else {
4019     return $self->custnum;
4020   }
4021 }
4022
4023 =item name
4024
4025 Returns a name string for this customer, either "Company (Last, First)" or
4026 "Last, First".
4027
4028 =cut
4029
4030 sub name {
4031   my $self = shift;
4032   my $name = $self->contact;
4033   $name = $self->company. " ($name)" if $self->company;
4034   $name;
4035 }
4036
4037 =item service_contact
4038
4039 Returns the L<FS::contact> object for this customer that has the 'Service'
4040 contact class, or undef if there is no such contact.  Deprecated; don't use
4041 this in new code.
4042
4043 =cut
4044
4045 sub service_contact {
4046   my $self = shift;
4047   if ( !exists($self->{service_contact}) ) {
4048     my $classnum = $self->scalar_sql(
4049       'SELECT classnum FROM contact_class WHERE classname = \'Service\''
4050     ) || 0; #if it's zero, qsearchs will return nothing
4051     $self->{service_contact} = qsearchs('contact', {
4052         'classnum' => $classnum, 'custnum' => $self->custnum
4053       }) || undef;
4054   }
4055   $self->{service_contact};
4056 }
4057
4058 =item ship_name
4059
4060 Returns a name string for this (service/shipping) contact, either
4061 "Company (Last, First)" or "Last, First".
4062
4063 =cut
4064
4065 sub ship_name {
4066   my $self = shift;
4067
4068   my $name = $self->ship_contact;
4069   $name = $self->company. " ($name)" if $self->company;
4070   $name;
4071 }
4072
4073 =item name_short
4074
4075 Returns a name string for this customer, either "Company" or "First Last".
4076
4077 =cut
4078
4079 sub name_short {
4080   my $self = shift;
4081   $self->company !~ /^\s*$/ ? $self->company : $self->contact_firstlast;
4082 }
4083
4084 =item ship_name_short
4085
4086 Returns a name string for this (service/shipping) contact, either "Company"
4087 or "First Last".
4088
4089 =cut
4090
4091 sub ship_name_short {
4092   my $self = shift;
4093   $self->service_contact
4094     ? $self->ship_contact_firstlast
4095     : $self->name_short
4096 }
4097
4098 =item contact
4099
4100 Returns this customer's full (billing) contact name only, "Last, First"
4101
4102 =cut
4103
4104 sub contact {
4105   my $self = shift;
4106   $self->get('last'). ', '. $self->first;
4107 }
4108
4109 =item ship_contact
4110
4111 Returns this customer's full (shipping) contact name only, "Last, First"
4112
4113 =cut
4114
4115 sub ship_contact {
4116   my $self = shift;
4117   my $contact = $self->service_contact || $self;
4118   $contact->get('last') . ', ' . $contact->get('first');
4119 }
4120
4121 =item contact_firstlast
4122
4123 Returns this customers full (billing) contact name only, "First Last".
4124
4125 =cut
4126
4127 sub contact_firstlast {
4128   my $self = shift;
4129   $self->first. ' '. $self->get('last');
4130 }
4131
4132 =item ship_contact_firstlast
4133
4134 Returns this customer's full (shipping) contact name only, "First Last".
4135
4136 =cut
4137
4138 sub ship_contact_firstlast {
4139   my $self = shift;
4140   my $contact = $self->service_contact || $self;
4141   $contact->get('first') . ' '. $contact->get('last');
4142 }
4143
4144 #XXX this doesn't work in 3.x+
4145 #=item country_full
4146 #
4147 #Returns this customer's full country name
4148 #
4149 #=cut
4150 #
4151 #sub country_full {
4152 #  my $self = shift;
4153 #  code2country($self->country);
4154 #}
4155
4156 sub bill_country_full {
4157   my $self = shift;
4158   code2country($self->bill_location->country);
4159 }
4160
4161 sub ship_country_full {
4162   my $self = shift;
4163   code2country($self->ship_location->country);
4164 }
4165
4166 =item county_state_county [ PREFIX ]
4167
4168 Returns a string consisting of just the county, state and country.
4169
4170 =cut
4171
4172 sub county_state_country {
4173   my $self = shift;
4174   my $locationnum;
4175   if ( @_ && $_[0] && $self->has_ship_address ) {
4176     $locationnum = $self->ship_locationnum;
4177   } else {
4178     $locationnum = $self->bill_locationnum;
4179   }
4180   my $cust_location = qsearchs('cust_location', { locationnum=>$locationnum });
4181   $cust_location->county_state_country;
4182 }
4183
4184 =item geocode DATA_VENDOR
4185
4186 Returns a value for the customer location as encoded by DATA_VENDOR.
4187 Currently this only makes sense for "CCH" as DATA_VENDOR.
4188
4189 =cut
4190
4191 =item cust_status
4192
4193 =item status
4194
4195 Returns a status string for this customer, currently:
4196
4197 =over 4
4198
4199 =item prospect - No packages have ever been ordered
4200
4201 =item ordered - Recurring packages all are new (not yet billed).
4202
4203 =item active - One or more recurring packages is active
4204
4205 =item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled)
4206
4207 =item suspended - All non-cancelled recurring packages are suspended
4208
4209 =item cancelled - All recurring packages are cancelled
4210
4211 =back
4212
4213 Behavior of inactive vs. cancelled edge cases can be adjusted with the
4214 cust_main-status_module configuration option.
4215
4216 =cut
4217
4218 sub status { shift->cust_status(@_); }
4219
4220 sub cust_status {
4221   my $self = shift;
4222   for my $status ( FS::cust_main->statuses() ) {
4223     my $method = $status.'_sql';
4224     my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g;
4225     my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr;
4226     $sth->execute( ($self->custnum) x $numnum )
4227       or die "Error executing 'SELECT $sql': ". $sth->errstr;
4228     return $status if $sth->fetchrow_arrayref->[0];
4229   }
4230 }
4231
4232 =item ucfirst_cust_status
4233
4234 =item ucfirst_status
4235
4236 Returns the status with the first character capitalized.
4237
4238 =cut
4239
4240 sub ucfirst_status { shift->ucfirst_cust_status(@_); }
4241
4242 sub ucfirst_cust_status {
4243   my $self = shift;
4244   ucfirst($self->cust_status);
4245 }
4246
4247 =item statuscolor
4248
4249 Returns a hex triplet color string for this customer's status.
4250
4251 =cut
4252
4253 sub statuscolor { shift->cust_statuscolor(@_); }
4254
4255 sub cust_statuscolor {
4256   my $self = shift;
4257   __PACKAGE__->statuscolors->{$self->cust_status};
4258 }
4259
4260 =item tickets [ STATUS ]
4261
4262 Returns an array of hashes representing the customer's RT tickets.
4263
4264 An optional status (or arrayref or hashref of statuses) may be specified.
4265
4266 =cut
4267
4268 sub tickets {
4269   my $self = shift;
4270   my $status = ( @_ && $_[0] ) ? shift : '';
4271
4272   my $num = $conf->config('cust_main-max_tickets') || 10;
4273   my @tickets = ();
4274
4275   if ( $conf->config('ticket_system') ) {
4276     unless ( $conf->config('ticket_system-custom_priority_field') ) {
4277
4278       @tickets = @{ FS::TicketSystem->customer_tickets( $self->custnum,
4279                                                         $num,
4280                                                         undef,
4281                                                         $status,
4282                                                       )
4283                   };
4284
4285     } else {
4286
4287       foreach my $priority (
4288         $conf->config('ticket_system-custom_priority_field-values'), ''
4289       ) {
4290         last if scalar(@tickets) >= $num;
4291         push @tickets,
4292           @{ FS::TicketSystem->customer_tickets( $self->custnum,
4293                                                  $num - scalar(@tickets),
4294                                                  $priority,
4295                                                  $status,
4296                                                )
4297            };
4298       }
4299     }
4300   }
4301   (@tickets);
4302 }
4303
4304 # Return services representing svc_accts in customer support packages
4305 sub support_services {
4306   my $self = shift;
4307   my %packages = map { $_ => 1 } $conf->config('support_packages');
4308
4309   grep { $_->pkg_svc && $_->pkg_svc->primary_svc eq 'Y' }
4310     grep { $_->part_svc->svcdb eq 'svc_acct' }
4311     map { $_->cust_svc }
4312     grep { exists $packages{ $_->pkgpart } }
4313     $self->ncancelled_pkgs;
4314
4315 }
4316
4317 # Return a list of latitude/longitude for one of the services (if any)
4318 sub service_coordinates {
4319   my $self = shift;
4320
4321   my @svc_X =
4322     grep { $_->latitude && $_->longitude }
4323     map { $_->svc_x }
4324     map { $_->cust_svc }
4325     $self->ncancelled_pkgs;
4326
4327   scalar(@svc_X) ? ( $svc_X[0]->latitude, $svc_X[0]->longitude ) : ()
4328 }
4329
4330 =item masked FIELD
4331
4332 Returns a masked version of the named field
4333
4334 =cut
4335
4336 sub masked {
4337 my ($self,$field) = @_;
4338
4339 # Show last four
4340
4341 'x'x(length($self->getfield($field))-4).
4342   substr($self->getfield($field), (length($self->getfield($field))-4));
4343
4344 }
4345
4346 =back
4347
4348 =head1 CLASS METHODS
4349
4350 =over 4
4351
4352 =item statuses
4353
4354 Class method that returns the list of possible status strings for customers
4355 (see L<the status method|/status>).  For example:
4356
4357   @statuses = FS::cust_main->statuses();
4358
4359 =cut
4360
4361 sub statuses {
4362   my $self = shift;
4363   keys %{ $self->statuscolors };
4364 }
4365
4366 =item cust_status_sql
4367
4368 Returns an SQL fragment to determine the status of a cust_main record, as a
4369 string.
4370
4371 =cut
4372
4373 sub cust_status_sql {
4374   my $sql = 'CASE';
4375   for my $status ( FS::cust_main->statuses() ) {
4376     my $method = $status.'_sql';
4377     $sql .= ' WHEN ('.FS::cust_main->$method.") THEN '$status'";
4378   }
4379   $sql .= ' END';
4380   return $sql;
4381 }
4382
4383
4384 =item prospect_sql
4385
4386 Returns an SQL expression identifying prospective cust_main records (customers
4387 with no packages ever ordered)
4388
4389 =cut
4390
4391 use vars qw($select_count_pkgs);
4392 $select_count_pkgs =
4393   "SELECT COUNT(*) FROM cust_pkg
4394     WHERE cust_pkg.custnum = cust_main.custnum";
4395
4396 sub select_count_pkgs_sql {
4397   $select_count_pkgs;
4398 }
4399
4400 sub prospect_sql {
4401   " 0 = ( $select_count_pkgs ) ";
4402 }
4403
4404 =item ordered_sql
4405
4406 Returns an SQL expression identifying ordered cust_main records (customers with
4407 no active packages, but recurring packages not yet setup or one time charges
4408 not yet billed).
4409
4410 =cut
4411
4412 sub ordered_sql {
4413   FS::cust_main->none_active_sql.
4414   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->not_yet_billed_sql. " ) ";
4415 }
4416
4417 =item active_sql
4418
4419 Returns an SQL expression identifying active cust_main records (customers with
4420 active recurring packages).
4421
4422 =cut
4423
4424 sub active_sql {
4425   " 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4426 }
4427
4428 =item none_active_sql
4429
4430 Returns an SQL expression identifying cust_main records with no active
4431 recurring packages.  This includes customers of status prospect, ordered,
4432 inactive, and suspended.
4433
4434 =cut
4435
4436 sub none_active_sql {
4437   " 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) ";
4438 }
4439
4440 =item inactive_sql
4441
4442 Returns an SQL expression identifying inactive cust_main records (customers with
4443 no active recurring packages, but otherwise unsuspended/uncancelled).
4444
4445 =cut
4446
4447 sub inactive_sql {
4448   FS::cust_main->none_active_sql.
4449   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) ";
4450 }
4451
4452 =item susp_sql
4453 =item suspended_sql
4454
4455 Returns an SQL expression identifying suspended cust_main records.
4456
4457 =cut
4458
4459
4460 sub suspended_sql { susp_sql(@_); }
4461 sub susp_sql {
4462   FS::cust_main->none_active_sql.
4463   " AND 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) ";
4464 }
4465
4466 =item cancel_sql
4467 =item cancelled_sql
4468
4469 Returns an SQL expression identifying cancelled cust_main records.
4470
4471 =cut
4472
4473 sub cancel_sql { shift->cancelled_sql(@_); }
4474
4475 =item uncancel_sql
4476 =item uncancelled_sql
4477
4478 Returns an SQL expression identifying un-cancelled cust_main records.
4479
4480 =cut
4481
4482 sub uncancelled_sql { uncancel_sql(@_); }
4483 sub uncancel_sql { "
4484   ( 0 < ( $select_count_pkgs
4485                    AND ( cust_pkg.cancel IS NULL
4486                          OR cust_pkg.cancel = 0
4487                        )
4488         )
4489     OR 0 = ( $select_count_pkgs )
4490   )
4491 "; }
4492
4493 =item balance_sql
4494
4495 Returns an SQL fragment to retreive the balance.
4496
4497 =cut
4498
4499 sub balance_sql { "
4500     ( SELECT COALESCE( SUM(charged), 0 ) FROM cust_bill
4501         WHERE cust_bill.custnum   = cust_main.custnum     )
4502   - ( SELECT COALESCE( SUM(paid),    0 ) FROM cust_pay
4503         WHERE cust_pay.custnum    = cust_main.custnum     )
4504   - ( SELECT COALESCE( SUM(amount),  0 ) FROM cust_credit
4505         WHERE cust_credit.custnum = cust_main.custnum     )
4506   + ( SELECT COALESCE( SUM(refund),  0 ) FROM cust_refund
4507         WHERE cust_refund.custnum = cust_main.custnum     )
4508 "; }
4509
4510 =item balance_date_sql [ START_TIME [ END_TIME [ OPTION => VALUE ... ] ] ]
4511
4512 Returns an SQL fragment to retreive the balance for this customer, optionally
4513 considering invoices with date earlier than START_TIME, and not
4514 later than END_TIME (total_owed_date minus total_unapplied_credits minus
4515 total_unapplied_payments).
4516
4517 Times are specified as SQL fragments or numeric
4518 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4519 L<Date::Parse> for conversion functions.  The empty string can be passed
4520 to disable that time constraint completely.
4521
4522 Available options are:
4523
4524 =over 4
4525
4526 =item unapplied_date
4527
4528 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)
4529
4530 =item total
4531
4532 (unused.  obsolete?)
4533 set to true to remove all customer comparison clauses, for totals
4534
4535 =item where
4536
4537 (unused.  obsolete?)
4538 WHERE clause hashref (elements "AND"ed together) (typically used with the total option)
4539
4540 =item join
4541
4542 (unused.  obsolete?)
4543 JOIN clause (typically used with the total option)
4544
4545 =item cutoff
4546
4547 An absolute cutoff time.  Payments, credits, and refunds I<applied> after this
4548 time will be ignored.  Note that START_TIME and END_TIME only limit the date
4549 range for invoices and I<unapplied> payments, credits, and refunds.
4550
4551 =back
4552
4553 =cut
4554
4555 sub balance_date_sql {
4556   my( $class, $start, $end, %opt ) = @_;
4557
4558   my $cutoff = $opt{'cutoff'};
4559
4560   my $owed         = FS::cust_bill->owed_sql($cutoff);
4561   my $unapp_refund = FS::cust_refund->unapplied_sql($cutoff);
4562   my $unapp_credit = FS::cust_credit->unapplied_sql($cutoff);
4563   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4564
4565   my $j = $opt{'join'} || '';
4566
4567   my $owed_wh   = $class->_money_table_where( 'cust_bill',   $start,$end,%opt );
4568   my $refund_wh = $class->_money_table_where( 'cust_refund', $start,$end,%opt );
4569   my $credit_wh = $class->_money_table_where( 'cust_credit', $start,$end,%opt );
4570   my $pay_wh    = $class->_money_table_where( 'cust_pay',    $start,$end,%opt );
4571
4572   "   ( SELECT COALESCE(SUM($owed),         0) FROM cust_bill   $j $owed_wh   )
4573     + ( SELECT COALESCE(SUM($unapp_refund), 0) FROM cust_refund $j $refund_wh )
4574     - ( SELECT COALESCE(SUM($unapp_credit), 0) FROM cust_credit $j $credit_wh )
4575     - ( SELECT COALESCE(SUM($unapp_pay),    0) FROM cust_pay    $j $pay_wh    )
4576   ";
4577
4578 }
4579
4580 =item unapplied_payments_date_sql START_TIME [ END_TIME ]
4581
4582 Returns an SQL fragment to retreive the total unapplied payments for this
4583 customer, only considering payments with date earlier than START_TIME, and
4584 optionally not later than END_TIME.
4585
4586 Times are specified as SQL fragments or numeric
4587 UNIX timestamps; see L<perlfunc/"time">).  Also see L<Time::Local> and
4588 L<Date::Parse> for conversion functions.  The empty string can be passed
4589 to disable that time constraint completely.
4590
4591 Available options are:
4592
4593 =cut
4594
4595 sub unapplied_payments_date_sql {
4596   my( $class, $start, $end, %opt ) = @_;
4597
4598   my $cutoff = $opt{'cutoff'};
4599
4600   my $unapp_pay    = FS::cust_pay->unapplied_sql($cutoff);
4601
4602   my $pay_where = $class->_money_table_where( 'cust_pay', $start, $end,
4603                                                           'unapplied_date'=>1 );
4604
4605   " ( SELECT COALESCE(SUM($unapp_pay), 0) FROM cust_pay $pay_where ) ";
4606 }
4607
4608 =item _money_table_where TABLE START_TIME [ END_TIME [ OPTION => VALUE ... ] ]
4609
4610 Helper method for balance_date_sql; name (and usage) subject to change
4611 (suggestions welcome).
4612
4613 Returns a WHERE clause for the specified monetary TABLE (cust_bill,
4614 cust_refund, cust_credit or cust_pay).
4615
4616 If TABLE is "cust_bill" or the unapplied_date option is true, only
4617 considers records with date earlier than START_TIME, and optionally not
4618 later than END_TIME .
4619
4620 =cut
4621
4622 sub _money_table_where {
4623   my( $class, $table, $start, $end, %opt ) = @_;
4624
4625   my @where = ();
4626   push @where, "cust_main.custnum = $table.custnum" unless $opt{'total'};
4627   if ( $table eq 'cust_bill' || $opt{'unapplied_date'} ) {
4628     push @where, "$table._date <= $start" if defined($start) && length($start);
4629     push @where, "$table._date >  $end"   if defined($end)   && length($end);
4630   }
4631   push @where, @{$opt{'where'}} if $opt{'where'};
4632   my $where = scalar(@where) ? 'WHERE '. join(' AND ', @where ) : '';
4633
4634   $where;
4635
4636 }
4637
4638 #for dyanmic FS::$table->search in httemplate/misc/email_customers.html
4639 use FS::cust_main::Search;
4640 sub search {
4641   my $class = shift;
4642   FS::cust_main::Search->search(@_);
4643 }
4644
4645 =back
4646
4647 =head1 SUBROUTINES
4648
4649 =over 4
4650
4651 =item batch_charge
4652
4653 =cut
4654
4655 sub batch_charge {
4656   my $param = shift;
4657   #warn join('-',keys %$param);
4658   my $fh = $param->{filehandle};
4659   my $agentnum = $param->{agentnum};
4660   my $format = $param->{format};
4661
4662   my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql;
4663
4664   my @fields;
4665   if ( $format eq 'simple' ) {
4666     @fields = qw( custnum agent_custid amount pkg );
4667   } else {
4668     die "unknown format $format";
4669   }
4670
4671   eval "use Text::CSV_XS;";
4672   die $@ if $@;
4673
4674   my $csv = new Text::CSV_XS;
4675   #warn $csv;
4676   #warn $fh;
4677
4678   my $imported = 0;
4679   #my $columns;
4680
4681   local $SIG{HUP} = 'IGNORE';
4682   local $SIG{INT} = 'IGNORE';
4683   local $SIG{QUIT} = 'IGNORE';
4684   local $SIG{TERM} = 'IGNORE';
4685   local $SIG{TSTP} = 'IGNORE';
4686   local $SIG{PIPE} = 'IGNORE';
4687
4688   my $oldAutoCommit = $FS::UID::AutoCommit;
4689   local $FS::UID::AutoCommit = 0;
4690   my $dbh = dbh;
4691
4692   #while ( $columns = $csv->getline($fh) ) {
4693   my $line;
4694   while ( defined($line=<$fh>) ) {
4695
4696     $csv->parse($line) or do {
4697       $dbh->rollback if $oldAutoCommit;
4698       return "can't parse: ". $csv->error_input();
4699     };
4700
4701     my @columns = $csv->fields();
4702     #warn join('-',@columns);
4703
4704     my %row = ();
4705     foreach my $field ( @fields ) {
4706       $row{$field} = shift @columns;
4707     }
4708
4709     if ( $row{custnum} && $row{agent_custid} ) {
4710       dbh->rollback if $oldAutoCommit;
4711       return "can't specify custnum with agent_custid $row{agent_custid}";
4712     }
4713
4714     my %hash = ();
4715     if ( $row{agent_custid} && $agentnum ) {
4716       %hash = ( 'agent_custid' => $row{agent_custid},
4717                 'agentnum'     => $agentnum,
4718               );
4719     }
4720
4721     if ( $row{custnum} ) {
4722       %hash = ( 'custnum' => $row{custnum} );
4723     }
4724
4725     unless ( scalar(keys %hash) ) {
4726       $dbh->rollback if $oldAutoCommit;
4727       return "can't find customer without custnum or agent_custid and agentnum";
4728     }
4729
4730     my $cust_main = qsearchs('cust_main', { %hash } );
4731     unless ( $cust_main ) {
4732       $dbh->rollback if $oldAutoCommit;
4733       my $custnum = $row{custnum} || $row{agent_custid};
4734       return "unknown custnum $custnum";
4735     }
4736
4737     if ( $row{'amount'} > 0 ) {
4738       my $error = $cust_main->charge($row{'amount'}, $row{'pkg'});
4739       if ( $error ) {
4740         $dbh->rollback if $oldAutoCommit;
4741         return $error;
4742       }
4743       $imported++;
4744     } elsif ( $row{'amount'} < 0 ) {
4745       my $error = $cust_main->credit( sprintf( "%.2f", 0-$row{'amount'} ),
4746                                       $row{'pkg'}                         );
4747       if ( $error ) {
4748         $dbh->rollback if $oldAutoCommit;
4749         return $error;
4750       }
4751       $imported++;
4752     } else {
4753       #hmm?
4754     }
4755
4756   }
4757
4758   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4759
4760   return "Empty file!" unless $imported;
4761
4762   ''; #no error
4763
4764 }
4765
4766 =item notify CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4767
4768 Deprecated.  Use event notification and message templates
4769 (L<FS::msg_template>) instead.
4770
4771 Sends a templated email notification to the customer (see L<Text::Template>).
4772
4773 OPTIONS is a hash and may include
4774
4775 I<from> - the email sender (default is invoice_from)
4776
4777 I<to> - comma-separated scalar or arrayref of recipients
4778    (default is invoicing_list)
4779
4780 I<subject> - The subject line of the sent email notification
4781    (default is "Notice from company_name")
4782
4783 I<extra_fields> - a hashref of name/value pairs which will be substituted
4784    into the template
4785
4786 The following variables are vavailable in the template.
4787
4788 I<$first> - the customer first name
4789 I<$last> - the customer last name
4790 I<$company> - the customer company
4791 I<$payby> - a description of the method of payment for the customer
4792             # would be nice to use FS::payby::shortname
4793 I<$payinfo> - the account information used to collect for this customer
4794 I<$expdate> - the expiration of the customer payment in seconds from epoch
4795
4796 =cut
4797
4798 sub notify {
4799   my ($self, $template, %options) = @_;
4800
4801   return unless $conf->exists($template);
4802
4803   my $from = $conf->config('invoice_from', $self->agentnum)
4804     if $conf->exists('invoice_from', $self->agentnum);
4805   $from = $options{from} if exists($options{from});
4806
4807   my $to = join(',', $self->invoicing_list_emailonly);
4808   $to = $options{to} if exists($options{to});
4809
4810   my $subject = "Notice from " . $conf->config('company_name', $self->agentnum)
4811     if $conf->exists('company_name', $self->agentnum);
4812   $subject = $options{subject} if exists($options{subject});
4813
4814   my $notify_template = new Text::Template (TYPE => 'ARRAY',
4815                                             SOURCE => [ map "$_\n",
4816                                               $conf->config($template)]
4817                                            )
4818     or die "can't create new Text::Template object: Text::Template::ERROR";
4819   $notify_template->compile()
4820     or die "can't compile template: Text::Template::ERROR";
4821
4822   $FS::notify_template::_template::company_name =
4823     $conf->config('company_name', $self->agentnum);
4824   $FS::notify_template::_template::company_address =
4825     join("\n", $conf->config('company_address', $self->agentnum) ). "\n";
4826
4827   my $paydate = $self->paydate || '2037-12-31';
4828   $FS::notify_template::_template::first = $self->first;
4829   $FS::notify_template::_template::last = $self->last;
4830   $FS::notify_template::_template::company = $self->company;
4831   $FS::notify_template::_template::payinfo = $self->mask_payinfo;
4832   my $payby = $self->payby;
4833   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4834   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4835
4836   #credit cards expire at the end of the month/year of their exp date
4837   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4838     $FS::notify_template::_template::payby = 'credit card';
4839     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4840     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4841     $expire_time--;
4842   }elsif ($payby eq 'COMP') {
4843     $FS::notify_template::_template::payby = 'complimentary account';
4844   }else{
4845     $FS::notify_template::_template::payby = 'current method';
4846   }
4847   $FS::notify_template::_template::expdate = $expire_time;
4848
4849   for (keys %{$options{extra_fields}}){
4850     no strict "refs";
4851     ${"FS::notify_template::_template::$_"} = $options{extra_fields}->{$_};
4852   }
4853
4854   send_email(from => $from,
4855              to => $to,
4856              subject => $subject,
4857              body => $notify_template->fill_in( PACKAGE =>
4858                                                 'FS::notify_template::_template'                                              ),
4859             );
4860
4861 }
4862
4863 =item generate_letter CUSTOMER_OBJECT TEMPLATE_NAME OPTIONS
4864
4865 Generates a templated notification to the customer (see L<Text::Template>).
4866
4867 OPTIONS is a hash and may include
4868
4869 I<extra_fields> - a hashref of name/value pairs which will be substituted
4870    into the template.  These values may override values mentioned below
4871    and those from the customer record.
4872
4873 The following variables are available in the template instead of or in addition
4874 to the fields of the customer record.
4875
4876 I<$payby> - a description of the method of payment for the customer
4877             # would be nice to use FS::payby::shortname
4878 I<$payinfo> - the masked account information used to collect for this customer
4879 I<$expdate> - the expiration of the customer payment method in seconds from epoch
4880 I<$returnaddress> - the return address defaults to invoice_latexreturnaddress or company_address
4881
4882 =cut
4883
4884 # a lot like cust_bill::print_latex
4885 sub generate_letter {
4886   my ($self, $template, %options) = @_;
4887
4888   return unless $conf->exists($template);
4889
4890   my $letter_template = new Text::Template
4891                         ( TYPE       => 'ARRAY',
4892                           SOURCE     => [ map "$_\n", $conf->config($template)],
4893                           DELIMITERS => [ '[@--', '--@]' ],
4894                         )
4895     or die "can't create new Text::Template object: Text::Template::ERROR";
4896
4897   $letter_template->compile()
4898     or die "can't compile template: Text::Template::ERROR";
4899
4900   my %letter_data = map { $_ => $self->$_ } $self->fields;
4901   $letter_data{payinfo} = $self->mask_payinfo;
4902
4903   #my $paydate = $self->paydate || '2037-12-31';
4904   my $paydate = $self->paydate =~ /^\S+$/ ? $self->paydate : '2037-12-31';
4905
4906   my $payby = $self->payby;
4907   my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
4908   my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
4909
4910   #credit cards expire at the end of the month/year of their exp date
4911   if ($payby eq 'CARD' || $payby eq 'DCRD') {
4912     $letter_data{payby} = 'credit card';
4913     ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
4914     $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
4915     $expire_time--;
4916   }elsif ($payby eq 'COMP') {
4917     $letter_data{payby} = 'complimentary account';
4918   }else{
4919     $letter_data{payby} = 'current method';
4920   }
4921   $letter_data{expdate} = $expire_time;
4922
4923   for (keys %{$options{extra_fields}}){
4924     $letter_data{$_} = $options{extra_fields}->{$_};
4925   }
4926
4927   unless(exists($letter_data{returnaddress})){
4928     my $retadd = join("\n", $conf->config_orbase( 'invoice_latexreturnaddress',
4929                                                   $self->agent_template)
4930                      );
4931     if ( length($retadd) ) {
4932       $letter_data{returnaddress} = $retadd;
4933     } elsif ( grep /\S/, $conf->config('company_address', $self->agentnum) ) {
4934       $letter_data{returnaddress} =
4935         join( "\n", map { s/( {2,})/'~' x length($1)/eg;
4936                           s/$/\\\\\*/;
4937                           $_;
4938                         }
4939                     ( $conf->config('company_name', $self->agentnum),
4940                       $conf->config('company_address', $self->agentnum),
4941                     )
4942         );
4943     } else {
4944       $letter_data{returnaddress} = '~';
4945     }
4946   }
4947
4948   $letter_data{conf_dir} = "$FS::UID::conf_dir/conf.$FS::UID::datasrc";
4949
4950   $letter_data{company_name} = $conf->config('company_name', $self->agentnum);
4951
4952   my $dir = $FS::UID::conf_dir."/cache.". $FS::UID::datasrc;
4953
4954   my $lh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4955                            DIR      => $dir,
4956                            SUFFIX   => '.eps',
4957                            UNLINK   => 0,
4958                          ) or die "can't open temp file: $!\n";
4959   print $lh $conf->config_binary('logo.eps', $self->agentnum)
4960     or die "can't write temp file: $!\n";
4961   close $lh;
4962   $letter_data{'logo_file'} = $lh->filename;
4963
4964   my $fh = new File::Temp( TEMPLATE => 'letter.'. $self->custnum. '.XXXXXXXX',
4965                            DIR      => $dir,
4966                            SUFFIX   => '.tex',
4967                            UNLINK   => 0,
4968                          ) or die "can't open temp file: $!\n";
4969
4970   $letter_template->fill_in( OUTPUT => $fh, HASH => \%letter_data );
4971   close $fh;
4972   $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
4973   return ($1, $letter_data{'logo_file'});
4974
4975 }
4976
4977 =item print_ps TEMPLATE
4978
4979 Returns an postscript letter filled in from TEMPLATE, as a scalar.
4980
4981 =cut
4982
4983 sub print_ps {
4984   my $self = shift;
4985   my($file, $lfile) = $self->generate_letter(@_);
4986   my $ps = FS::Misc::generate_ps($file);
4987   unlink($file.'.tex');
4988   unlink($lfile);
4989
4990   $ps;
4991 }
4992
4993 =item print TEMPLATE
4994
4995 Prints the filled in template.
4996
4997 TEMPLATE is the name of a L<Text::Template> to fill in and print.
4998
4999 =cut
5000
5001 sub queueable_print {
5002   my %opt = @_;
5003
5004   my $self = qsearchs('cust_main', { 'custnum' => $opt{custnum} } )
5005     or die "invalid customer number: " . $opt{custnum};
5006
5007   my $error = $self->print( { 'template' => $opt{template} } );
5008   die $error if $error;
5009 }
5010
5011 sub print {
5012   my ($self, $template) = (shift, shift);
5013   do_print(
5014     [ $self->print_ps($template) ],
5015     'agentnum' => $self->agentnum,
5016   );
5017 }
5018
5019 #these three subs should just go away once agent stuff is all config overrides
5020
5021 sub agent_template {
5022   my $self = shift;
5023   $self->_agent_plandata('agent_templatename');
5024 }
5025
5026 sub agent_invoice_from {
5027   my $self = shift;
5028   $self->_agent_plandata('agent_invoice_from');
5029 }
5030
5031 sub _agent_plandata {
5032   my( $self, $option ) = @_;
5033
5034   #yuck.  this whole thing needs to be reconciled better with 1.9's idea of
5035   #agent-specific Conf
5036
5037   use FS::part_event::Condition;
5038
5039   my $agentnum = $self->agentnum;
5040
5041   my $regexp = regexp_sql();
5042
5043   my $part_event_option =
5044     qsearchs({
5045       'select'    => 'part_event_option.*',
5046       'table'     => 'part_event_option',
5047       'addl_from' => q{
5048         LEFT JOIN part_event USING ( eventpart )
5049         LEFT JOIN part_event_option AS peo_agentnum
5050           ON ( part_event.eventpart = peo_agentnum.eventpart
5051                AND peo_agentnum.optionname = 'agentnum'
5052                AND peo_agentnum.optionvalue }. $regexp. q{ '(^|,)}. $agentnum. q{(,|$)'
5053              )
5054         LEFT JOIN part_event_condition
5055           ON ( part_event.eventpart = part_event_condition.eventpart
5056                AND part_event_condition.conditionname = 'cust_bill_age'
5057              )
5058         LEFT JOIN part_event_condition_option
5059           ON ( part_event_condition.eventconditionnum = part_event_condition_option.eventconditionnum
5060                AND part_event_condition_option.optionname = 'age'
5061              )
5062       },
5063       #'hashref'   => { 'optionname' => $option },
5064       #'hashref'   => { 'part_event_option.optionname' => $option },
5065       'extra_sql' =>
5066         " WHERE part_event_option.optionname = ". dbh->quote($option).
5067         " AND action = 'cust_bill_send_agent' ".
5068         " AND ( disabled IS NULL OR disabled != 'Y' ) ".
5069         " AND peo_agentnum.optionname = 'agentnum' ".
5070         " AND ( agentnum IS NULL OR agentnum = $agentnum ) ".
5071         " ORDER BY
5072            CASE WHEN part_event_condition_option.optionname IS NULL
5073            THEN -1
5074            ELSE ". FS::part_event::Condition->age2seconds_sql('part_event_condition_option.optionvalue').
5075         " END
5076           , part_event.weight".
5077         " LIMIT 1"
5078     });
5079
5080   unless ( $part_event_option ) {
5081     return $self->agent->invoice_template || ''
5082       if $option eq 'agent_templatename';
5083     return '';
5084   }
5085
5086   $part_event_option->optionvalue;
5087
5088 }
5089
5090 =item queued_bill 'custnum' => CUSTNUM [ , OPTION => VALUE ... ]
5091
5092 Subroutine (not a method), designed to be called from the queue.
5093
5094 Takes a list of options and values.
5095
5096 Pulls up the customer record via the custnum option and calls bill_and_collect.
5097
5098 =cut
5099
5100 sub queued_bill {
5101   my (%args) = @_; #, ($time, $invoice_time, $check_freq, $resetup) = @_;
5102
5103   my $cust_main = qsearchs( 'cust_main', { custnum => $args{'custnum'} } );
5104   warn 'bill_and_collect custnum#'. $cust_main->custnum. "\n";#log custnum w/pid
5105
5106   #without this errors don't get rolled back
5107   $args{'fatal'} = 1; # runs from job queue, will be caught
5108
5109   $cust_main->bill_and_collect( %args );
5110 }
5111
5112 sub process_bill_and_collect {
5113   my $job = shift;
5114   my $param = thaw(decode_base64(shift));
5115   my $cust_main = qsearchs( 'cust_main', { custnum => $param->{'custnum'} } )
5116       or die "custnum '$param->{custnum}' not found!\n";
5117   $param->{'job'}   = $job;
5118   $param->{'fatal'} = 1; # runs from job queue, will be caught
5119   $param->{'retry'} = 1;
5120
5121   $cust_main->bill_and_collect( %$param );
5122 }
5123
5124 #starting to take quite a while for big dbs
5125 #   (JRNL: journaled so it only happens once per database)
5126 # - seq scan of h_cust_main (yuck), but not going to index paycvv, so
5127 # JRNL seq scan of cust_main on signupdate... index signupdate?  will that help?
5128 # JRNL seq scan of cust_main on paydate... index on substrings?  maybe set an
5129 # JRNL seq scan of cust_main on payinfo.. certainly not going toi ndex that...
5130 # JRNL leading/trailing spaces in first, last, company
5131 # - otaker upgrade?  journal and call it good?  (double check to make sure
5132 #    we're not still setting otaker here)
5133 #
5134 #only going to get worse with new location stuff...
5135
5136 sub _upgrade_data { #class method
5137   my ($class, %opts) = @_;
5138
5139   my @statements = (
5140     'UPDATE h_cust_main SET paycvv = NULL WHERE paycvv IS NOT NULL',
5141   );
5142
5143   #this seems to be the only expensive one.. why does it take so long?
5144   unless ( FS::upgrade_journal->is_done('cust_main__signupdate') ) {
5145     push @statements,
5146       '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';
5147     FS::upgrade_journal->set_done('cust_main__signupdate');
5148   }
5149
5150   unless ( FS::upgrade_journal->is_done('cust_main__paydate') ) {
5151
5152     # fix yyyy-m-dd formatted paydates
5153     if ( driver_name =~ /^mysql/i ) {
5154       push @statements,
5155       "UPDATE cust_main SET paydate = CONCAT( SUBSTRING(paydate FROM 1 FOR 5), '0', SUBSTRING(paydate FROM 6) ) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5156     } else { # the SQL standard
5157       push @statements,
5158       "UPDATE cust_main SET paydate = SUBSTRING(paydate FROM 1 FOR 5) || '0' || SUBSTRING(paydate FROM 6) WHERE SUBSTRING(paydate FROM 7 FOR 1) = '-'";
5159     }
5160     FS::upgrade_journal->set_done('cust_main__paydate');
5161   }
5162
5163   unless ( FS::upgrade_journal->is_done('cust_main__payinfo') ) {
5164
5165     push @statements, #fix the weird BILL with a cc# in payinfo problem
5166       #DCRD to be safe
5167       "UPDATE cust_main SET payby = 'DCRD' WHERE payby = 'BILL' and length(payinfo) = 16 and payinfo ". regexp_sql. q( '^[0-9]*$' );
5168
5169     FS::upgrade_journal->set_done('cust_main__payinfo');
5170
5171   }
5172
5173   my $t = time;
5174   foreach my $sql ( @statements ) {
5175     my $sth = dbh->prepare($sql) or die dbh->errstr;
5176     $sth->execute or die $sth->errstr;
5177     #warn ( (time - $t). " seconds\n" );
5178     #$t = time;
5179   }
5180
5181   local($ignore_expired_card) = 1;
5182   local($ignore_banned_card) = 1;
5183   local($skip_fuzzyfiles) = 1;
5184   local($import) = 1; #prevent automatic geocoding (need its own variable?)
5185
5186   FS::cust_main::Location->_upgrade_data(%opts);
5187
5188   unless ( FS::upgrade_journal->is_done('cust_main__trimspaces') ) {
5189
5190     foreach my $cust_main ( qsearch({
5191       'table'     => 'cust_main',
5192       'hashref'   => {},
5193       'extra_sql' => 'WHERE '.
5194                        join(' OR ',
5195                          map "$_ LIKE ' %' OR $_ LIKE '% ' OR $_ LIKE '%  %'",
5196                            qw( first last company )
5197                        ),
5198     }) ) {
5199       my $error = $cust_main->replace;
5200       die $error if $error;
5201     }
5202
5203     FS::upgrade_journal->set_done('cust_main__trimspaces');
5204
5205   }
5206
5207   $class->_upgrade_otaker(%opts);
5208
5209 }
5210
5211 =back
5212
5213 =head1 BUGS
5214
5215 The delete method.
5216
5217 The delete method should possibly take an FS::cust_main object reference
5218 instead of a scalar customer number.
5219
5220 Bill and collect options should probably be passed as references instead of a
5221 list.
5222
5223 There should probably be a configuration file with a list of allowed credit
5224 card types.
5225
5226 No multiple currency support (probably a larger project than just this module).
5227
5228 payinfo_masked false laziness with cust_pay.pm and cust_refund.pm
5229
5230 Birthdates rely on negative epoch values.
5231
5232 The payby for card/check batches is broken.  With mixed batching, bad
5233 things will happen.
5234
5235 B<collect> I<invoice_time> should be renamed I<time>, like B<bill>.
5236
5237 =head1 SEE ALSO
5238
5239 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
5240 L<FS::agent>, L<FS::part_referral>, L<FS::cust_main_county>,
5241 L<FS::cust_main_invoice>, L<FS::UID>, schema.html from the base documentation.
5242
5243 =cut
5244
5245 1;
5246