FS/FS/cust_main.pm

   1 #this is so kludgy i'd be embarassed if it wasn't cybercash's fault
   2 package main;
   3 use vars qw($paymentserversecret $paymentserverport $paymentserverhost);
   4
   5 package FS::cust_main;
   6
   7 use strict;
   8 use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from
   9              $smtpmachine $Debug );
  10 use Safe;
  11 use Carp;
  12 use Time::Local;
  13 use Date::Format;
  14 #use Date::Manip;
  15 use Mail::Internet;
  16 use Mail::Header;
  17 use Business::CreditCard;
  18 use FS::UID qw( getotaker dbh );
  19 use FS::Record qw( qsearchs qsearch );
  20 use FS::cust_pkg;
  21 use FS::cust_bill;
  22 use FS::cust_bill_pkg;
  23 use FS::cust_pay;
  24 use FS::cust_credit;
  25 use FS::cust_pay_batch;
  26 use FS::part_referral;
  27 use FS::cust_main_county;
  28 use FS::agent;
  29 use FS::cust_main_invoice;
  30 use FS::prepay_credit;
  31
  32 @ISA = qw( FS::Record );
  33
  34 $Debug = 0;
  35 #$Debug = 1;
  36
  37 #ask FS::UID to run this stuff for us later
  38 $FS::UID::callback{'FS::cust_main'} = sub {
  39   $conf = new FS::Conf;
  40   $lpr = $conf->config('lpr');
  41   $invoice_from = $conf->config('invoice_from');
  42   $smtpmachine = $conf->config('smtpmachine');
  43
  44   if ( $conf->exists('cybercash3.2') ) {
  45     require CCMckLib3_2;
  46       #qw($MCKversion %Config InitConfig CCError CCDebug CCDebug2);
  47     require CCMckDirectLib3_2;
  48       #qw(SendCC2_1Server);
  49     require CCMckErrno3_2;
  50       #qw(MCKGetErrorMessage $E_NoErr);
  51     import CCMckErrno3_2 qw($E_NoErr);
  52
  53     my $merchant_conf;
  54     ($merchant_conf,$xaction)= $conf->config('cybercash3.2');
  55     my $status = &CCMckLib3_2::InitConfig($merchant_conf);
  56     if ( $status != $E_NoErr ) {
  57       warn "CCMckLib3_2::InitConfig error:\n";
  58       foreach my $key (keys %CCMckLib3_2::Config) {
  59         warn "  $key => $CCMckLib3_2::Config{$key}\n"
  60       }
  61       my($errmsg) = &CCMckErrno3_2::MCKGetErrorMessage($status);
  62       die "CCMckLib3_2::InitConfig fatal error: $errmsg\n";
  63     }
  64     $processor='cybercash3.2';
  65   } elsif ( $conf->exists('cybercash2') ) {
  66     require CCLib;
  67       #qw(sendmserver);
  68     ( $main::paymentserverhost,
  69       $main::paymentserverport,
  70       $main::paymentserversecret,
  71       $xaction,
  72     ) = $conf->config('cybercash2');
  73     $processor='cybercash2';
  74   }
  75 };
  76
  77 =head1 NAME
  78
  79 FS::cust_main - Object methods for cust_main records
  80
  81 =head1 SYNOPSIS
  82
  83   use FS::cust_main;
  84
  85   $record = new FS::cust_main \%hash;
  86   $record = new FS::cust_main { 'column' => 'value' };
  87
  88   $error = $record->insert;
  89
  90   $error = $new_record->replace($old_record);
  91
  92   $error = $record->delete;
  93
  94   $error = $record->check;
  95
  96   @cust_pkg = $record->all_pkgs;
  97
  98   @cust_pkg = $record->ncancelled_pkgs;
  99
 100   $error = $record->bill;
 101   $error = $record->bill %options;
 102   $error = $record->bill 'time' => $time;
 103
 104   $error = $record->collect;
 105   $error = $record->collect %options;
 106   $error = $record->collect 'invoice_time'   => $time,
 107                             'batch_card'     => 'yes',
 108                             'report_badcard' => 'yes',
 109                           ;
 110
 111 =head1 DESCRIPTION
 112
 113 An FS::cust_main object represents a customer.  FS::cust_main inherits from
 114 FS::Record.  The following fields are currently supported:
 115
 116 =over 4
 117
 118 =item custnum - primary key (assigned automatically for new customers)
 119
 120 =item agentnum - agent (see L<FS::agent>)
 121
 122 =item refnum - referral (see L<FS::part_referral>)
 123
 124 =item first - name
 125
 126 =item last - name
 127
 128 =item ss - social security number (optional)
 129
 130 =item company - (optional)
 131
 132 =item address1
 133
 134 =item address2 - (optional)
 135
 136 =item city
 137
 138 =item county - (optional, see L<FS::cust_main_county>)
 139
 140 =item state - (see L<FS::cust_main_county>)
 141
 142 =item zip
 143
 144 =item country - (see L<FS::cust_main_county>)
 145
 146 =item daytime - phone (optional)
 147
 148 =item night - phone (optional)
 149
 150 =item fax - phone (optional)
 151
 152 =item ship_first - name
 153
 154 =item ship_last - name
 155
 156 =item ship_company - (optional)
 157
 158 =item ship_address1
 159
 160 =item ship_address2 - (optional)
 161
 162 =item ship_city
 163
 164 =item ship_county - (optional, see L<FS::cust_main_county>)
 165
 166 =item ship_state - (see L<FS::cust_main_county>)
 167
 168 =item ship_zip
 169
 170 =item ship_country - (see L<FS::cust_main_county>)
 171
 172 =item ship_daytime - phone (optional)
 173
 174 =item ship_night - phone (optional)
 175
 176 =item ship_fax - phone (optional)
 177
 178 =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to BILL)
 179
 180 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 181
 182 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy
 183
 184 =item payname - name on card or billing name
 185
 186 =item tax - tax exempt, empty or `Y'
 187
 188 =item otaker - order taker (assigned automatically, see L<FS::UID>)
 189
 190 =back
 191
 192 =head1 METHODS
 193
 194 =over 4
 195
 196 =item new HASHREF
 197
 198 Creates a new customer.  To add the customer to the database, see L<"insert">.
 199
 200 Note that this stores the hash reference, not a distinct copy of the hash it
 201 points to.  You can ask the object for a copy with the I<hash> method.
 202
 203 =cut
 204
 205 sub table { 'cust_main'; }
 206
 207 =item insert
 208
 209 Adds this customer to the database.  If there is an error, returns the error,
 210 otherwise returns false.
 211
 212 There is a special insert mode in which you pass a data structure to the insert
 213 method containing FS::cust_pkg and FS::svc_I<tablename> objects.  When
 214 running under a transactional database, all records are inserted atomicly, or
 215 the transaction is rolled back.  There should be a better explanation of this,
 216 but until then, here's an example:
 217
 218   use Tie::RefHash;
 219   tie %hash, 'Tie::RefHash'; #this part is important
 220   %hash = (
 221     $cust_pkg => [ $svc_acct ],
 222     ...
 223   );
 224   $cust_main->insert( \%hash );
 225
 226 =cut
 227
 228 sub insert {
 229   my $self = shift;
 230   my @param = @_;
 231
 232   local $SIG{HUP} = 'IGNORE';
 233   local $SIG{INT} = 'IGNORE';
 234   local $SIG{QUIT} = 'IGNORE';
 235   local $SIG{TERM} = 'IGNORE';
 236   local $SIG{TSTP} = 'IGNORE';
 237   local $SIG{PIPE} = 'IGNORE';
 238
 239   my $oldAutoCommit = $FS::UID::AutoCommit;
 240   local $FS::UID::AutoCommit = 0;
 241   my $dbh = dbh;
 242
 243   my $amount = 0;
 244   my $seconds = 0;
 245   if ( $self->payby eq 'PREPAY' ) {
 246     $self->payby('BILL');
 247     my $prepay_credit = qsearchs(
 248       'prepay_credit',
 249       { 'identifier' => $self->payinfo },
 250       '',
 251       'FOR UPDATE'
 252     );
 253     warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
 254       unless $prepay_credit;
 255     $amount = $prepay_credit->amount;
 256     $seconds = $prepay_credit->seconds;
 257     my $error = $prepay_credit->delete;
 258     if ( $error ) {
 259       $dbh->rollback if $oldAutoCommit;
 260       return $error;
 261     }
 262   }
 263
 264   my $error = $self->SUPER::insert;
 265   if ( $error ) {
 266     $dbh->rollback if $oldAutoCommit;
 267     return $error;
 268   }
 269
 270   if ( @param ) {
 271     my $cust_pkgs = shift @param;
 272     foreach my $cust_pkg ( keys %$cust_pkgs ) {
 273       $cust_pkg->custnum( $self->custnum );
 274       $error = $cust_pkg->insert;
 275       if ( $error ) {
 276         $dbh->rollback if $oldAutoCommit;
 277         return $error;
 278       }
 279       foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
 280         $svc_something->pkgnum( $cust_pkg->pkgnum );
 281         if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
 282           $svc_something->seconds( $svc_something->seconds + $seconds );
 283           $seconds = 0;
 284         }
 285         $error = $svc_something->insert;
 286         if ( $error ) {
 287           $dbh->rollback if $oldAutoCommit;
 288           return $error;
 289         }
 290       }
 291     }
 292   }
 293
 294   if ( $seconds ) {
 295     $dbh->rollback if $oldAutoCommit;
 296     return "No svc_acct record to apply pre-paid time";
 297   }
 298
 299   if ( $amount ) {
 300     my $cust_credit = new FS::cust_credit {
 301       'custnum' => $self->custnum,
 302       'amount'  => $amount,
 303     };
 304     $error = $cust_credit->insert;
 305     if ( $error ) {
 306       $dbh->rollback if $oldAutoCommit;
 307       return $error;
 308     }
 309   }
 310
 311   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 312   '';
 313
 314 }
 315
 316 =item delete NEW_CUSTNUM
 317
 318 This deletes the customer.  If there is an error, returns the error, otherwise
 319 returns false.
 320
 321 This will completely remove all traces of the customer record.  This is not
 322 what you want when a customer cancels service; for that, cancel all of the
 323 customer's packages (see L<FS::cust_pkg/cancel>).
 324
 325 If the customer has any packages, you need to pass a new (valid) customer
 326 number for those packages to be transferred to.
 327
 328 You can't delete a customer with invoices (see L<FS::cust_bill>),
 329 or credits (see L<FS::cust_credit>).
 330
 331 =cut
 332
 333 sub delete {
 334   my $self = shift;
 335
 336   local $SIG{HUP} = 'IGNORE';
 337   local $SIG{INT} = 'IGNORE';
 338   local $SIG{QUIT} = 'IGNORE';
 339   local $SIG{TERM} = 'IGNORE';
 340   local $SIG{TSTP} = 'IGNORE';
 341   local $SIG{PIPE} = 'IGNORE';
 342
 343   my $oldAutoCommit = $FS::UID::AutoCommit;
 344   local $FS::UID::AutoCommit = 0;
 345   my $dbh = dbh;
 346
 347   if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) {
 348     $dbh->rollback if $oldAutoCommit;
 349     return "Can't delete a customer with invoices";
 350   }
 351   if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) {
 352     $dbh->rollback if $oldAutoCommit;
 353     return "Can't delete a customer with credits";
 354   }
 355
 356   my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } );
 357   if ( @cust_pkg ) {
 358     my $new_custnum = shift;
 359     unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) {
 360       $dbh->rollback if $oldAutoCommit;
 361       return "Invalid new customer number: $new_custnum";
 362     }
 363     foreach my $cust_pkg ( @cust_pkg ) {
 364       my %hash = $cust_pkg->hash;
 365       $hash{'custnum'} = $new_custnum;
 366       my $new_cust_pkg = new FS::cust_pkg ( \%hash );
 367       my $error = $new_cust_pkg->replace($cust_pkg);
 368       if ( $error ) {
 369         $dbh->rollback if $oldAutoCommit;
 370         return $error;
 371       }
 372     }
 373   }
 374   foreach my $cust_main_invoice (
 375     qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } )
 376   ) {
 377     my $error = $cust_main_invoice->delete;
 378     if ( $error ) {
 379       $dbh->rollback if $oldAutoCommit;
 380       return $error;
 381     }
 382   }
 383
 384   my $error = $self->SUPER::delete;
 385   if ( $error ) {
 386     $dbh->rollback if $oldAutoCommit;
 387     return $error;
 388   }
 389
 390   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 391   '';
 392
 393 }
 394
 395 =item replace OLD_RECORD
 396
 397 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 398 returns the error, otherwise returns false.
 399
 400 =item check
 401
 402 Checks all fields to make sure this is a valid customer record.  If there is
 403 an error, returns the error, otherwise returns false.  Called by the insert
 404 and repalce methods.
 405
 406 =cut
 407
 408 sub check {
 409   my $self = shift;
 410
 411   my $error =
 412     $self->ut_numbern('custnum')
 413     || $self->ut_number('agentnum')
 414     || $self->ut_number('refnum')
 415     || $self->ut_name('last')
 416     || $self->ut_name('first')
 417     || $self->ut_textn('company')
 418     || $self->ut_text('address1')
 419     || $self->ut_textn('address2')
 420     || $self->ut_text('city')
 421     || $self->ut_textn('county')
 422     || $self->ut_textn('state')
 423   ;
 424   #barf.  need message catalogs.  i18n.  etc.
 425   $error .= "Please select a referral."
 426     if $error =~ /^Illegal or empty \(numeric\) refnum: /;
 427   return $error if $error;
 428
 429   return "Unknown agent"
 430     unless qsearchs( 'agent', { 'agentnum' => $self->agentnum } );
 431
 432   return "Unknown referral"
 433     unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } );
 434
 435   if ( $self->ss eq '' ) {
 436     $self->ss('');
 437   } else {
 438     my $ss = $self->ss;
 439     $ss =~ s/\D//g;
 440     $ss =~ /^(\d{3})(\d{2})(\d{4})$/
 441       or return "Illegal social security number: ". $self->ss;
 442     $self->ss("$1-$2-$3");
 443   }
 444
 445   $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country;
 446   $self->country($1);
 447   unless ( qsearchs('cust_main_county', {
 448     'country' => $self->country,
 449     'state'   => '',
 450    } ) ) {
 451     return "Unknown state/county/country: ".
 452       $self->state. "/". $self->county. "/". $self->country
 453       unless qsearchs('cust_main_county',{
 454         'state'   => $self->state,
 455         'county'  => $self->county,
 456         'country' => $self->country,
 457       } );
 458   }
 459
 460   $error =
 461     $self->ut_phonen('daytime', $self->country)
 462     || $self->ut_phonen('night', $self->country)
 463     || $self->ut_phonen('fax', $self->country)
 464     || $self->ut_zip('zip', $self->country)
 465   ;
 466   return $error if $error;
 467
 468   if ( defined $self->dbdef_table->column('ship_last') ) {
 469     if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") }
 470               qw( last first company address1 address2 city county state zip
 471                   country daytime night fax )
 472        ) # if any address fields differ
 473     {
 474       my $error =
 475         $self->ut_name('ship_last')
 476         || $self->ut_name('ship_first')
 477         || $self->ut_textn('ship_company')
 478         || $self->ut_text('ship_address1')
 479         || $self->ut_textn('ship_address2')
 480         || $self->ut_text('ship_city')
 481         || $self->ut_textn('ship_county')
 482         || $self->ut_textn('ship_state')
 483       ;
 484       return $error if $error;
 485
 486       #false laziness with above
 487       $self->ship_country =~ /^(\w\w)$/
 488         or return "Illegal ship_country: ". $self->ship_country;
 489       $self->ship_country($1);
 490       unless ( qsearchs('cust_main_county', {
 491         'country' => $self->ship_country,
 492         'state'   => '',
 493        } ) ) {
 494         return "Unknown ship_state/ship_county/ship_country: ".
 495           $self->ship_state. "/". $self->ship_county. "/". $self->ship_country
 496           unless qsearchs('cust_main_county',{
 497             'state'   => $self->ship_state,
 498             'county'  => $self->ship_county,
 499             'country' => $self->ship_country,
 500           } );
 501       }
 502       #eofalse
 503
 504       $error =
 505         $self->ut_phonen('ship_daytime', $self->ship_country)
 506         || $self->ut_phonen('ship_night', $self->ship_country)
 507         || $self->ut_phonen('ship_fax', $self->ship_country)
 508         || $self->ut_zip('ship_zip', $self->ship_country)
 509       ;
 510       return $error if $error;
 511
 512     } else { # ship_ info eq billing info, so don't store dup info in database
 513       $self->setfield("ship_$_", '')
 514         foreach qw( last first company address1 address2 city county state zip
 515                     country daytime night fax );
 516     }
 517   }
 518
 519   $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/
 520     or return "Illegal payby: ". $self->payby;
 521   $self->payby($1);
 522
 523   if ( $self->payby eq 'CARD' ) {
 524
 525     my $payinfo = $self->payinfo;
 526     $payinfo =~ s/\D//g;
 527     $payinfo =~ /^(\d{13,16})$/
 528       or return "Illegal credit card number: ". $self->payinfo;
 529     $payinfo = $1;
 530     $self->payinfo($payinfo);
 531     validate($payinfo)
 532       or return "Illegal credit card number: ". $self->payinfo;
 533     return "Unknown card type" if cardtype($self->payinfo) eq "Unknown";
 534
 535   } elsif ( $self->payby eq 'BILL' ) {
 536
 537     $error = $self->ut_textn('payinfo');
 538     return "Illegal P.O. number: ". $self->payinfo if $error;
 539
 540   } elsif ( $self->payby eq 'COMP' ) {
 541
 542     $error = $self->ut_textn('payinfo');
 543     return "Illegal comp account issuer: ". $self->payinfo if $error;
 544
 545   } elsif ( $self->payby eq 'PREPAY' ) {
 546
 547     my $payinfo = $self->payinfo;
 548     $payinfo =~ s/\W//g; #anything else would just confuse things
 549     $self->payinfo($payinfo);
 550     $error = $self->ut_alpha('payinfo');
 551     return "Illegal prepayment identifier: ". $self->payinfo if $error;
 552     return "Unknown prepayment identifier"
 553       unless qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
 554
 555   }
 556
 557   if ( $self->paydate eq '' || $self->paydate eq '-' ) {
 558     return "Expriation date required"
 559       unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY';
 560     $self->paydate('');
 561   } else {
 562     $self->paydate =~ /^(\d{1,2})[\/\-](\d{2}(\d{2})?)$/
 563       or return "Illegal expiration date: ". $self->paydate;
 564     if ( length($2) == 4 ) {
 565       $self->paydate("$2-$1-01");
 566     } elsif ( $2 > 97 ) { #should pry change to check for "this year"
 567       $self->paydate("19$2-$1-01");
 568     } else {
 569       $self->paydate("20$2-$1-01");
 570     }
 571   }
 572
 573   if ( $self->payname eq '' ) {
 574     $self->payname( $self->first. " ". $self->getfield('last') );
 575   } else {
 576     $self->payname =~ /^([\w \,\.\-\']+)$/
 577       or return "Illegal billing name: ". $self->payname;
 578     $self->payname($1);
 579   }
 580
 581   $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax;
 582   $self->tax($1);
 583
 584   $self->otaker(getotaker);
 585
 586   ''; #no error
 587 }
 588
 589 =item all_pkgs
 590
 591 Returns all packages (see L<FS::cust_pkg>) for this customer.
 592
 593 =cut
 594
 595 sub all_pkgs {
 596   my $self = shift;
 597   qsearch( 'cust_pkg', { 'custnum' => $self->custnum });
 598 }
 599
 600 =item ncancelled_pkgs
 601
 602 Returns all non-cancelled packages (see L<FS::cust_pkg>) for this customer.
 603
 604 =cut
 605
 606 sub ncancelled_pkgs {
 607   my $self = shift;
 608   @{ [ # force list context
 609     qsearch( 'cust_pkg', {
 610       'custnum' => $self->custnum,
 611       'cancel'  => '',
 612     }),
 613     qsearch( 'cust_pkg', {
 614       'custnum' => $self->custnum,
 615       'cancel'  => 0,
 616     }),
 617   ] };
 618 }
 619
 620 =item bill OPTIONS
 621
 622 Generates invoices (see L<FS::cust_bill>) for this customer.  Usually used in
 623 conjunction with the collect method.
 624
 625 The only currently available option is `time', which bills the customer as if
 626 it were that time.  It is specified as a UNIX timestamp; see
 627 L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse> for conversion
 628 functions.
 629
 630 If there is an error, returns the error, otherwise returns false.
 631
 632 =cut
 633
 634 sub bill {
 635   my( $self, %options ) = @_;
 636   my $time = $options{'time'} || time;
 637
 638   my $error;
 639
 640   #put below somehow?
 641   local $SIG{HUP} = 'IGNORE';
 642   local $SIG{INT} = 'IGNORE';
 643   local $SIG{QUIT} = 'IGNORE';
 644   local $SIG{TERM} = 'IGNORE';
 645   local $SIG{TSTP} = 'IGNORE';
 646   local $SIG{PIPE} = 'IGNORE';
 647
 648   my $oldAutoCommit = $FS::UID::AutoCommit;
 649   local $FS::UID::AutoCommit = 0;
 650   my $dbh = dbh;
 651
 652   # find the packages which are due for billing, find out how much they are
 653   # & generate invoice database.
 654
 655   my( $total_setup, $total_recur ) = ( 0, 0 );
 656   my @cust_bill_pkg;
 657
 658   foreach my $cust_pkg (
 659     qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } )
 660   ) {
 661
 662     next if $cust_pkg->getfield('cancel');
 663
 664     #? to avoid use of uninitialized value errors... ?
 665     $cust_pkg->setfield('bill', '')
 666       unless defined($cust_pkg->bill);
 667
 668     my $part_pkg = qsearchs( 'part_pkg', { 'pkgpart' => $cust_pkg->pkgpart } );
 669
 670     #so we don't modify cust_pkg record unnecessarily
 671     my $cust_pkg_mod_flag = 0;
 672     my %hash = $cust_pkg->hash;
 673     my $old_cust_pkg = new FS::cust_pkg \%hash;
 674
 675     # bill setup
 676     my $setup = 0;
 677     unless ( $cust_pkg->setup ) {
 678       my $setup_prog = $part_pkg->getfield('setup');
 679       $setup_prog =~ /^(.*)$/ #presumably trusted
 680         or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog";
 681       $setup_prog = $1;
 682       my $cpt = new Safe;
 683       #$cpt->permit(); #what is necessary?
 684       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 685       $setup = $cpt->reval($setup_prog);
 686       unless ( defined($setup) ) {
 687         warn "Error reval-ing part_pkg->setup pkgpart ",
 688              $part_pkg->pkgpart, ": $@";
 689       } else {
 690         $cust_pkg->setfield('setup',$time);
 691         $cust_pkg_mod_flag=1;
 692       }
 693     }
 694
 695     #bill recurring fee
 696     my $recur = 0;
 697     my $sdate;
 698     if ( $part_pkg->getfield('freq') > 0 &&
 699          ! $cust_pkg->getfield('susp') &&
 700          ( $cust_pkg->getfield('bill') || 0 ) < $time
 701     ) {
 702       my $recur_prog = $part_pkg->getfield('recur');
 703       $recur_prog =~ /^(.*)$/ #presumably trusted
 704         or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog";
 705       $recur_prog = $1;
 706       my $cpt = new Safe;
 707       #$cpt->permit(); #what is necessary?
 708       $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods?
 709       $recur = $cpt->reval($recur_prog);
 710       unless ( defined($recur) ) {
 711         warn "Error reval-ing part_pkg->recur pkgpart ",
 712              $part_pkg->pkgpart, ": $@";
 713       } else {
 714         #change this bit to use Date::Manip? CAREFUL with timezones (see
 715         # mailing list archive)
 716         #$sdate=$cust_pkg->bill || time;
 717         #$sdate=$cust_pkg->bill || $time;
 718         $sdate = $cust_pkg->bill || $cust_pkg->setup || $time;
 719         my ($sec,$min,$hour,$mday,$mon,$year) =
 720           (localtime($sdate) )[0,1,2,3,4,5];
 721         $mon += $part_pkg->getfield('freq');
 722         until ( $mon < 12 ) { $mon -= 12; $year++; }
 723         $cust_pkg->setfield('bill',
 724           timelocal($sec,$min,$hour,$mday,$mon,$year));
 725         $cust_pkg_mod_flag = 1;
 726       }
 727     }
 728
 729     warn "setup is undefined" unless defined($setup);
 730     warn "recur is undefined" unless defined($recur);
 731     warn "cust_pkg bill is undefined" unless defined($cust_pkg->bill);
 732
 733     if ( $cust_pkg_mod_flag ) {
 734       $error=$cust_pkg->replace($old_cust_pkg);
 735       if ( $error ) { #just in case
 736         warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error";
 737       } else {
 738         $setup = sprintf( "%.2f", $setup );
 739         $recur = sprintf( "%.2f", $recur );
 740         my $cust_bill_pkg = new FS::cust_bill_pkg ({
 741           'pkgnum' => $cust_pkg->pkgnum,
 742           'setup'  => $setup,
 743           'recur'  => $recur,
 744           'sdate'  => $sdate,
 745           'edate'  => $cust_pkg->bill,
 746         });
 747         push @cust_bill_pkg, $cust_bill_pkg;
 748         $total_setup += $setup;
 749         $total_recur += $recur;
 750       }
 751     }
 752
 753   }
 754
 755   my $charged = sprintf( "%.2f", $total_setup + $total_recur );
 756
 757   unless ( @cust_bill_pkg ) {
 758     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 759     return '';
 760   }
 761
 762   unless ( $self->getfield('tax') =~ /Y/i
 763            || $self->getfield('payby') eq 'COMP'
 764   ) {
 765     my $cust_main_county = qsearchs('cust_main_county',{
 766         'state'   => $self->state,
 767         'county'  => $self->county,
 768         'country' => $self->country,
 769     } );
 770     my $tax = sprintf( "%.2f",
 771       $charged * ( $cust_main_county->getfield('tax') / 100 )
 772     );
 773     $charged = sprintf( "%.2f", $charged+$tax );
 774
 775     my $cust_bill_pkg = new FS::cust_bill_pkg ({
 776       'pkgnum' => 0,
 777       'setup'  => $tax,
 778       'recur'  => 0,
 779       'sdate'  => '',
 780       'edate'  => '',
 781     });
 782     push @cust_bill_pkg, $cust_bill_pkg;
 783   }
 784
 785   my $cust_bill = new FS::cust_bill ( {
 786     'custnum' => $self->getfield('custnum'),
 787     '_date' => $time,
 788     'charged' => $charged,
 789   } );
 790   $error = $cust_bill->insert;
 791   if ( $error ) {
 792     $dbh->rollback if $oldAutoCommit;
 793     return "$error for customer #". $self->custnum;
 794   }
 795
 796   my $invnum = $cust_bill->invnum;
 797   my $cust_bill_pkg;
 798   foreach $cust_bill_pkg ( @cust_bill_pkg ) {
 799     $cust_bill_pkg->setfield( 'invnum', $invnum );
 800     $error = $cust_bill_pkg->insert;
 801     #shouldn't happen, but how else tohandle this?
 802     if ( $error ) {
 803       $dbh->rollback if $oldAutoCommit;
 804       return "$error for customer #". $self->custnum;
 805     }
 806   }
 807
 808   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 809   ''; #no error
 810 }
 811
 812 =item collect OPTIONS
 813
 814 (Attempt to) collect money for this customer's outstanding invoices (see
 815 L<FS::cust_bill>).  Usually used after the bill method.
 816
 817 Depending on the value of `payby', this may print an invoice (`BILL'), charge
 818 a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP').
 819
 820 If there is an error, returns the error, otherwise returns false.
 821
 822 Currently available options are:
 823
 824 invoice_time - Use this time when deciding when to print invoices and
 825 late notices on those invoices.  The default is now.  It is specified as a UNIX timestamp; see L<perlfunc/"time">).  Also see L<Time::Local> and L<Date::Parse>
 826 for conversion functions.
 827
 828 batch_card - Set this true to batch cards (see L<cust_pay_batch>).  By
 829 default, cards are processed immediately, which will generate an error if
 830 CyberCash is not installed.
 831
 832 report_badcard - Set this true if you want bad card transactions to
 833 return an error.  By default, they don't.
 834
 835 =cut
 836
 837 sub collect {
 838   my( $self, %options ) = @_;
 839   my $invoice_time = $options{'invoice_time'} || time;
 840
 841   #put below somehow?
 842   local $SIG{HUP} = 'IGNORE';
 843   local $SIG{INT} = 'IGNORE';
 844   local $SIG{QUIT} = 'IGNORE';
 845   local $SIG{TERM} = 'IGNORE';
 846   local $SIG{TSTP} = 'IGNORE';
 847   local $SIG{PIPE} = 'IGNORE';
 848
 849   my $oldAutoCommit = $FS::UID::AutoCommit;
 850   local $FS::UID::AutoCommit = 0;
 851   my $dbh = dbh;
 852
 853   my $total_owed = $self->balance;
 854   warn "collect: total owed $total_owed " if $Debug;
 855   unless ( $total_owed > 0 ) { #redundant?????
 856     $dbh->rollback if $oldAutoCommit;
 857     return '';
 858   }
 859
 860   foreach my $cust_bill (
 861     qsearch('cust_bill', { 'custnum' => $self->custnum, } )
 862   ) {
 863
 864     #this has to be before next's
 865     my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed
 866                                   ? $total_owed
 867                                   : $cust_bill->owed
 868     );
 869     $total_owed = sprintf( "%.2f", $total_owed - $amount );
 870
 871     next unless $cust_bill->owed > 0;
 872
 873     next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } );
 874
 875     warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug;
 876
 877     next unless $amount > 0;
 878
 879     if ( $self->payby eq 'BILL' ) {
 880
 881       #30 days 2592000
 882       my $since = $invoice_time - ( $cust_bill->_date || 0 );
 883       #warn "$invoice_time ", $cust_bill->_date, " $since";
 884       if ( $since >= 0 #don't print future invoices
 885            && ( $cust_bill->printed * 2592000 ) <= $since
 886       ) {
 887
 888         #my @print_text = $cust_bill->print_text; #( date )
 889         my @invoicing_list = $self->invoicing_list;
 890         if ( grep { $_ ne 'POST' } @invoicing_list ) { #email invoice
 891           $ENV{SMTPHOSTS} = $smtpmachine;
 892           $ENV{MAILADDRESS} = $invoice_from;
 893           my $header = new Mail::Header ( [
 894             "From: $invoice_from",
 895             "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
 896             "Sender: $invoice_from",
 897             "Reply-To: $invoice_from",
 898             "Date: ". time2str("%a, %d %b %Y %X %z", time),
 899             "Subject: Invoice",
 900           ] );
 901           my $message = new Mail::Internet (
 902             'Header' => $header,
 903             'Body' => [ $cust_bill->print_text ], #( date)
 904           );
 905           $message->smtpsend or die "Can't send invoice email!"; #die?  warn?
 906
 907         } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
 908           open(LPR, "|$lpr") or die "Can't open pipe to $lpr: $!";
 909           print LPR $cust_bill->print_text; #( date )
 910           close LPR
 911             or die $! ? "Error closing $lpr: $!"
 912                          : "Exit status $? from $lpr";
 913         }
 914
 915         my %hash = $cust_bill->hash;
 916         $hash{'printed'}++;
 917         my $new_cust_bill = new FS::cust_bill(\%hash);
 918         my $error = $new_cust_bill->replace($cust_bill);
 919         warn "Error updating $cust_bill->printed: $error" if $error;
 920
 921       }
 922
 923     } elsif ( $self->payby eq 'COMP' ) {
 924       my $cust_pay = new FS::cust_pay ( {
 925          'invnum' => $cust_bill->invnum,
 926          'paid' => $amount,
 927          '_date' => '',
 928          'payby' => 'COMP',
 929          'payinfo' => $self->payinfo,
 930          'paybatch' => ''
 931       } );
 932       my $error = $cust_pay->insert;
 933       if ( $error ) {
 934         $dbh->rollback if $oldAutoCommit;
 935         return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error";
 936       }
 937
 938
 939     } elsif ( $self->payby eq 'CARD' ) {
 940
 941       if ( $options{'batch_card'} ne 'yes' ) {
 942
 943         unless ( $processor ) {
 944           $dbh->rollback if $oldAutoCommit;
 945           return "Real time card processing not enabled!";
 946         }
 947
 948         if ( $processor =~ /^cybercash/ ) {
 949
 950           #fix exp. date for cybercash
 951           #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/;
 952           $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
 953           my $exp = "$2/$1";
 954
 955           my $paybatch = $cust_bill->invnum.
 956                          '-' . time2str("%y%m%d%H%M%S", time);
 957
 958           my $payname = $self->payname ||
 959                         $self->getfield('first'). ' '. $self->getfield('last');
 960
 961           my $address = $self->address1;
 962           $address .= ", ". $self->address2 if $self->address2;
 963
 964           my $country = 'USA' if $self->country eq 'US';
 965
 966           my @full_xaction = ( $xaction,
 967             'Order-ID'     => $paybatch,
 968             'Amount'       => "usd $amount",
 969             'Card-Number'  => $self->getfield('payinfo'),
 970             'Card-Name'    => $payname,
 971             'Card-Address' => $address,
 972             'Card-City'    => $self->getfield('city'),
 973             'Card-State'   => $self->getfield('state'),
 974             'Card-Zip'     => $self->getfield('zip'),
 975             'Card-Country' => $country,
 976             'Card-Exp'     => $exp,
 977           );
 978
 979           my %result;
 980           if ( $processor eq 'cybercash2' ) {
 981             $^W=0; #CCLib isn't -w safe, ugh!
 982             %result = &CCLib::sendmserver(@full_xaction);
 983             $^W=1;
 984           } elsif ( $processor eq 'cybercash3.2' ) {
 985             %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction);
 986           } else {
 987             $dbh->rollback if $oldAutoCommit;
 988             return "Unknown real-time processor $processor";
 989           }
 990
 991           #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3
 992           #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1
 993           if ( $result{'MStatus'} eq 'success' ) { #cybercash smps v.2 or 3
 994             my $cust_pay = new FS::cust_pay ( {
 995                'invnum'   => $cust_bill->invnum,
 996                'paid'     => $amount,
 997                '_date'     => '',
 998                'payby'    => 'CARD',
 999                'payinfo'  => $self->payinfo,
1000                'paybatch' => "$processor:$paybatch",
1001             } );
1002             my $error = $cust_pay->insert;
1003             if ( $error ) {
1004               # gah, even with transactions.
1005               $dbh->commit if $oldAutoCommit; #well.
1006               my $e = 'WARNING: Card debited but database not updated - '.
1007                       'error applying payment, invnum #' . $cust_bill->invnum.
1008                       " (CyberCash Order-ID $paybatch): $error";
1009               warn $e;
1010               return $e;
1011             }
1012           } elsif ( $result{'Mstatus'} ne 'failure-bad-money'
1013                  || $options{'report_badcard'} ) {
1014              $dbh->commit if $oldAutoCommit;
1015              return 'Cybercash error, invnum #' .
1016                $cust_bill->invnum. ':'. $result{'MErrMsg'};
1017           } else {
1018             $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1019             return '';
1020           }
1021
1022         } else {
1023           $dbh->rollback if $oldAutoCommit;
1024           return "Unknown real-time processor $processor\n";
1025         }
1026
1027       } else { #batch card
1028
1029        my $cust_pay_batch = new FS::cust_pay_batch ( {
1030          'invnum'   => $cust_bill->getfield('invnum'),
1031          'custnum'  => $self->getfield('custnum'),
1032          'last'     => $self->getfield('last'),
1033          'first'    => $self->getfield('first'),
1034          'address1' => $self->getfield('address1'),
1035          'address2' => $self->getfield('address2'),
1036          'city'     => $self->getfield('city'),
1037          'state'    => $self->getfield('state'),
1038          'zip'      => $self->getfield('zip'),
1039          'country'  => $self->getfield('country'),
1040          'trancode' => 77,
1041          'cardnum'  => $self->getfield('payinfo'),
1042          'exp'      => $self->getfield('paydate'),
1043          'payname'  => $self->getfield('payname'),
1044          'amount'   => $amount,
1045        } );
1046        my $error = $cust_pay_batch->insert;
1047        if ( $error ) {
1048          $dbh->rollback if $oldAutoCommit;
1049          return "Error adding to cust_pay_batch: $error";
1050        }
1051
1052       }
1053
1054     } else {
1055       $dbh->rollback if $oldAutoCommit;
1056       return "Unknown payment type ". $self->payby;
1057     }
1058
1059   }
1060   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1061   '';
1062
1063 }
1064
1065 =item total_owed
1066
1067 Returns the total owed for this customer on all invoices
1068 (see L<FS::cust_bill>).
1069
1070 =cut
1071
1072 sub total_owed {
1073   my $self = shift;
1074   my $total_bill = 0;
1075   foreach my $cust_bill ( qsearch('cust_bill', {
1076     'custnum' => $self->custnum,
1077   } ) ) {
1078     $total_bill += $cust_bill->owed;
1079   }
1080   sprintf( "%.2f", $total_bill );
1081 }
1082
1083 =item total_credited
1084
1085 Returns the total credits (see L<FS::cust_credit>) for this customer.
1086
1087 =cut
1088
1089 sub total_credited {
1090   my $self = shift;
1091   my $total_credit = 0;
1092   foreach my $cust_credit ( qsearch('cust_credit', {
1093     'custnum' => $self->custnum,
1094   } ) ) {
1095     $total_credit += $cust_credit->credited;
1096   }
1097   sprintf( "%.2f", $total_credit );
1098 }
1099
1100 =item balance
1101
1102 Returns the balance for this customer (total owed minus total credited).
1103
1104 =cut
1105
1106 sub balance {
1107   my $self = shift;
1108   sprintf( "%.2f", $self->total_owed - $self->total_credited );
1109 }
1110
1111 =item invoicing_list [ ARRAYREF ]
1112
1113 If an arguement is given, sets these email addresses as invoice recipients
1114 (see L<FS::cust_main_invoice>).  Errors are not fatal and are not reported
1115 (except as warnings), so use check_invoicing_list first.
1116
1117 Returns a list of email addresses (with svcnum entries expanded).
1118
1119 Note: You can clear the invoicing list by passing an empty ARRAYREF.  You can
1120 check it without disturbing anything by passing nothing.
1121
1122 This interface may change in the future.
1123
1124 =cut
1125
1126 sub invoicing_list {
1127   my( $self, $arrayref ) = @_;
1128   if ( $arrayref ) {
1129     my @cust_main_invoice;
1130     if ( $self->custnum ) {
1131       @cust_main_invoice =
1132         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1133     } else {
1134       @cust_main_invoice = ();
1135     }
1136     foreach my $cust_main_invoice ( @cust_main_invoice ) {
1137       #warn $cust_main_invoice->destnum;
1138       unless ( grep { $cust_main_invoice->address eq $_ } @{$arrayref} ) {
1139         #warn $cust_main_invoice->destnum;
1140         my $error = $cust_main_invoice->delete;
1141         warn $error if $error;
1142       }
1143     }
1144     if ( $self->custnum ) {
1145       @cust_main_invoice =
1146         qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1147     } else {
1148       @cust_main_invoice = ();
1149     }
1150     foreach my $address ( @{$arrayref} ) {
1151       unless ( grep { $address eq $_->address } @cust_main_invoice ) {
1152         my $cust_main_invoice = new FS::cust_main_invoice ( {
1153           'custnum' => $self->custnum,
1154           'dest'    => $address,
1155         } );
1156         my $error = $cust_main_invoice->insert;
1157         warn $error if $error;
1158       }
1159     }
1160   }
1161   if ( $self->custnum ) {
1162     map { $_->address }
1163       qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } );
1164   } else {
1165     ();
1166   }
1167 }
1168
1169 =item check_invoicing_list ARRAYREF
1170
1171 Checks these arguements as valid input for the invoicing_list method.  If there
1172 is an error, returns the error, otherwise returns false.
1173
1174 =cut
1175
1176 sub check_invoicing_list {
1177   my( $self, $arrayref ) = @_;
1178   foreach my $address ( @{$arrayref} ) {
1179     my $cust_main_invoice = new FS::cust_main_invoice ( {
1180       'custnum' => $self->custnum,
1181       'dest'    => $address,
1182     } );
1183     my $error = $self->custnum
1184                 ? $cust_main_invoice->check
1185                 : $cust_main_invoice->checkdest
1186     ;
1187     return $error if $error;
1188   }
1189   '';
1190 }
1191
1192 =back
1193
1194 =head1 VERSION
1195
1196 $Id: cust_main.pm,v 1.15 2001-07-30 10:41:44 ivan Exp $
1197
1198 =head1 BUGS
1199
1200 The delete method.
1201
1202 The delete method should possibly take an FS::cust_main object reference
1203 instead of a scalar customer number.
1204
1205 Bill and collect options should probably be passed as references instead of a
1206 list.
1207
1208 CyberCash v2 forces us to define some variables in package main.
1209
1210 There should probably be a configuration file with a list of allowed credit
1211 card types.
1212
1213 CyberCash is the only processor.
1214
1215 No multiple currency support (probably a larger project than just this module).
1216
1217 =head1 SEE ALSO
1218
1219 L<FS::Record>, L<FS::cust_pkg>, L<FS::cust_bill>, L<FS::cust_credit>
1220 L<FS::cust_pay_batch>, L<FS::agent>, L<FS::part_referral>,
1221 L<FS::cust_main_county>, L<FS::cust_main_invoice>,
1222 L<FS::UID>, schema.html from the base documentation.
1223
1224 =cut
1225
1226 1;
1227
1228