X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=5d68dddb1d9ef40bd7c2093bec24b9b4f4911d6d;hb=b0c95cb531f14d955b246b94c2bd8548eb8f0241;hp=4004d04f4cfa857b94ba3a427cd5d366062c818b;hpb=edd6c7e5d669b05b16d16e4f804107d8d25bc236;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 4004d04f4..5d68dddb1 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,7 +1,8 @@ package FS::cust_main; use strict; -use vars qw( @ISA @EXPORT_OK $conf $DEBUG $import @encrypted_fields); +use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields + $import $skip_fuzzyfiles ); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; @@ -50,9 +51,10 @@ use FS::Msgcat qw(gettext); $realtime_bop_decline_quiet = 0; $DEBUG = 0; -#$DEBUG = 1; +$me = '[FS::cust_main]'; $import = 0; +$skip_fuzzyfiles = 0; @encrypted_fields = ('payinfo', 'paycvv'); @@ -347,33 +349,21 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $prepay_credit = ''; - my $seconds = 0; + my $prepay_identifier = ''; + my( $amount, $seconds ) = ( 0, 0 ); if ( $self->payby eq 'PREPAY' ) { + $self->payby('BILL'); - $prepay_credit = qsearchs( - 'prepay_credit', - { 'identifier' => $self->payinfo }, - '', - 'FOR UPDATE' - ); - unless ( $prepay_credit ) { - $dbh->rollback if $oldAutoCommit; - return "Invalid prepaid card: ". $self->payinfo; - } - $seconds = $prepay_credit->seconds; - if ( $prepay_credit->agentnum ) { - if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) { - $dbh->rollback if $oldAutoCommit; - return "prepaid card not valid for agent ". $self->agentnum; - } - $self->agentnum($prepay_credit->agentnum); - } - my $error = $prepay_credit->delete; + $prepay_identifier = $self->payinfo; + $self->payinfo(''); + + my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "removing prepay_credit (transaction rolled back): $error"; + #return "error applying prepaid card (transaction rolled back): $error"; + return $error; } + } my $error = $self->SUPER::insert; @@ -405,25 +395,20 @@ sub insert { return "No svc_acct record to apply pre-paid time"; } - if ( $prepay_credit && $prepay_credit->amount ) { - my $cust_pay = new FS::cust_pay { - 'custnum' => $self->custnum, - 'paid' => $prepay_credit->amount, - #'_date' => #date the prepaid card was purchased??? - 'payby' => 'PREP', - 'payinfo' => $prepay_credit->identifier, - }; - $error = $cust_pay->insert; + if ( $amount ) { + $error = $self->insert_cust_pay_prepay($amount, $prepay_identifier); if ( $error ) { $dbh->rollback if $oldAutoCommit; return "inserting prepayment (transaction rolled back): $error"; } } - $error = $self->queue_fuzzyfiles_update; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "updating fuzzy search cache: $error"; + unless ( $import || $skip_fuzzyfiles ) { + $error = $self->queue_fuzzyfiles_update; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "updating fuzzy search cache: $error"; + } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -522,6 +507,195 @@ sub order_pkgs { ''; #no error } +=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ] + +Recharges this (existing) customer with the specified prepaid card (see +L), specified either by I or as an +FS::prepay_credit object. If there is an error, returns the error, otherwise +returns false. + +Optionally, two scalar references can be passed as well. They will have their +values filled in with the amount and number of seconds applied by this prepaid +card. + +=cut + +sub recharge_prepay { + my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my( $amount, $seconds ) = ( 0, 0 ); + + my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds) + || $self->increment_seconds($seconds) + || $self->insert_cust_pay_prepay( $amount, + ref($prepay_credit) + ? $prepay_credit->identifier + : $prepay_credit + ); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + if ( defined($amountref) ) { $$amountref = $amount; } + if ( defined($secondsref) ) { $$secondsref = $seconds; } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF + +Looks up and deletes a prepaid card (see L), +specified either by I or as an FS::prepay_credit object. + +References to I and I scalars should be passed as arguments +and will be incremented by the values of the prepaid card. + +If the prepaid card specifies an I (see L), it is used to +check or set this customer's I. + +If there is an error, returns the error, otherwise returns false. + +=cut + + +sub get_prepay { + my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + unless ( ref($prepay_credit) ) { + + my $identifier = $prepay_credit; + + $prepay_credit = qsearchs( + 'prepay_credit', + { 'identifier' => $prepay_credit }, + '', + 'FOR UPDATE' + ); + + unless ( $prepay_credit ) { + $dbh->rollback if $oldAutoCommit; + return "Invalid prepaid card: ". $identifier; + } + + } + + if ( $prepay_credit->agentnum ) { + if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) { + $dbh->rollback if $oldAutoCommit; + return "prepaid card not valid for agent ". $self->agentnum; + } + $self->agentnum($prepay_credit->agentnum); + } + + my $error = $prepay_credit->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "removing prepay_credit (transaction rolled back): $error"; + } + + $$amountref += $prepay_credit->amount; + $$secondsref += $prepay_credit->seconds; + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item increment_seconds SECONDS + +Updates this customer's single or primary account (see L) by +the specified number of seconds. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_seconds { + my( $self, $seconds ) = @_; + warn "$me increment_seconds called: $seconds seconds\n" + if $DEBUG; + + my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') } + $self->ncancelled_pkgs; + + if ( ! @cust_pkg ) { + return 'No packages with primary or single services found'. + ' to apply pre-paid time'; + } elsif ( scalar(@cust_pkg) > 1 ) { + #maybe have a way to specify the package/account? + return 'Multiple packages found to apply pre-paid time'; + } + + my $cust_pkg = $cust_pkg[0]; + warn " found package pkgnum ". $cust_pkg->pkgnum. "\n" + if $DEBUG; + + my @cust_svc = + $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') ); + + if ( ! @cust_svc ) { + return 'No account found to apply pre-paid time'; + } elsif ( scalar(@cust_svc) > 1 ) { + return 'Multiple accounts found to apply pre-paid time'; + } + + my $svc_acct = $cust_svc[0]->svc_x; + warn " found service svcnum ". $svc_acct->pkgnum. + ' ('. $svc_acct->email. ")\n" + if $DEBUG; + + $svc_acct->increment_seconds($seconds); + +} + +=item insert_cust_pay_prepay AMOUNT [ PAYINFO ] + +Inserts a prepayment in the specified amount for this customer. An optional +second argument can specify the prepayment identifier for tracking purposes. +If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_cust_pay_prepay { + my( $self, $amount ) = splice(@_, 0, 2); + my $payinfo = scalar(@_) ? shift : ''; + + my $cust_pay = new FS::cust_pay { + 'custnum' => $self->custnum, + 'paid' => sprintf('%.2f', $amount), + #'_date' => #date the prepaid card was purchased??? + 'payby' => 'PREP', + 'payinfo' => $payinfo, + }; + $cust_pay->insert; + +} + =item reexport This method is deprecated. See the I option to the insert and @@ -735,10 +909,12 @@ sub replace { } } - $error = $self->queue_fuzzyfiles_update; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "updating fuzzy search cache: $error"; + unless ( $import || $skip_fuzzyfiles ) { + $error = $self->queue_fuzzyfiles_update; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "updating fuzzy search cache: $error"; + } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -827,7 +1003,7 @@ sub check { return "Unknown refnum" unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); - return "Unknown referring custnum ". $self->referral_custnum + return "Unknown referring custnum: ". $self->referral_custnum unless ! $self->referral_custnum || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } ); @@ -1259,7 +1435,7 @@ If there is an error, returns the error, otherwise returns false. sub bill { my( $self, %options ) = @_; return '' if $self->payby eq 'COMP'; - warn "bill customer ". $self->custnum if $DEBUG; + warn "bill customer ". $self->custnum. "\n" if $DEBUG; my $time = $options{'time'} || time; @@ -1298,7 +1474,7 @@ sub bill { #NO!! next if $cust_pkg->cancel; next if $cust_pkg->getfield('cancel'); - warn " bill package ". $cust_pkg->pkgnum if $DEBUG; + warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG; #? to avoid use of uninitialized value errors... ? $cust_pkg->setfield('bill', '') @@ -1315,7 +1491,7 @@ sub bill { my $setup = 0; if ( !$cust_pkg->setup || $options{'resetup'} ) { - warn " bill setup" if $DEBUG; + warn " bill setup\n" if $DEBUG; $setup = eval { $cust_pkg->calc_setup( $time ) }; if ( $@ ) { @@ -1334,7 +1510,7 @@ sub bill { ( $cust_pkg->getfield('bill') || 0 ) <= $time ) { - warn " bill recur" if $DEBUG; + warn " bill recur\n" if $DEBUG; # XXX shared with $recur_prog $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; @@ -1667,7 +1843,7 @@ sub collect { $self->select_for_update; #mutex my $balance = $self->balance; - warn "collect customer ". $self->custnum. ": balance $balance" if $DEBUG; + warn "collect customer ". $self->custnum. ": balance $balance\n" if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -1692,7 +1868,7 @@ sub collect { last if $self->balance <= 0; - warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")" + warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n" if $DEBUG; foreach my $part_bill_event ( @@ -1907,7 +2083,10 @@ sub realtime_bop { || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { push @invoicing_list, $self->all_emails; } - my $email = $invoicing_list[0]; + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; my $payinfo = exists($options{'payinfo'}) ? $options{'payinfo'} @@ -2204,7 +2383,7 @@ sub realtime_refund_bop { $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } ) or return "Unknown paynum $options{'paynum'}"; $amount ||= $cust_pay->paid; - $cust_pay->paybatch =~ /^(\w+):(\w*)(:(\w+))?$/ + $cust_pay->paybatch =~ /^(\w+):([\w-]*)(:(\w+))?$/ or return "Can't parse paybatch for paynum $options{'paynum'}: ". $cust_pay->paybatch; ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 ); @@ -2981,11 +3160,53 @@ Returns a name string for this customer, either "Company (Last, First)" or sub name { my $self = shift; - my $name = $self->get('last'). ', '. $self->first; + my $name = $self->contact; $name = $self->company. " ($name)" if $self->company; $name; } +=item ship_name + +Returns a name string for this (service/shipping) contact, either +"Company (Last, First)" or "Last, First". + +=cut + +sub ship_name { + my $self = shift; + if ( $self->get('ship_last') ) { + my $name = $self->ship_contact; + $name = $self->ship_company. " ($name)" if $self->ship_company; + $name; + } else { + $self->name; + } +} + +=item contact + +Returns this customer's full (billing) contact name only, "Last, First" + +=cut + +sub contact { + my $self = shift; + $self->get('last'). ', '. $self->first; +} + +=item ship_contact + +Returns this customer's full (shipping) contact name only, "Last, First" + +=cut + +sub ship_contact { + my $self = shift; + $self->get('ship_last') + ? $self->get('ship_last'). ', '. $self->ship_first + : $self->contact; +} + =item status Returns a status string for this customer, currently: @@ -3057,9 +3278,15 @@ Returns an SQL expression identifying active cust_main records. =cut +my $recurring_sql = " + '0' != ( select freq from part_pkg + where cust_pkg.pkgpart = part_pkg.pkgpart ) +"; + sub active_sql { " 0 < ( SELECT COUNT(*) FROM cust_pkg WHERE cust_pkg.custnum = cust_main.custnum + AND $recurring_sql AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) ) @@ -3076,10 +3303,12 @@ sub suspended_sql { susp_sql(@_); } sub susp_sql { " 0 < ( SELECT COUNT(*) FROM cust_pkg WHERE cust_pkg.custnum = cust_main.custnum + AND $recurring_sql AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) ) AND 0 = ( SELECT COUNT(*) FROM cust_pkg WHERE cust_pkg.custnum = cust_main.custnum + AND $recurring_sql AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) ) @@ -3099,6 +3328,7 @@ sub cancel_sql { " ) AND 0 = ( SELECT COUNT(*) FROM cust_pkg WHERE cust_pkg.custnum = cust_main.custnum + AND $recurring_sql AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) ) "; }