X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pay.pm;h=acb2844290b39934a652f8ee14df5423f2b3b404;hb=41ed76e0e3625c9f175743d253ad06fc67302d0f;hp=5d31d2cde63ce7a4e5b42979db156187b1e73f0f;hpb=eb4ff7f73c5d4bdf74a3472448b5a195598ff4cd;p=freeside.git diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 5d31d2cde..acb284429 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -1,12 +1,16 @@ package FS::cust_pay; use strict; -use vars qw( @ISA $conf $unsuspendauto $ignore_noapply @encrypted_fields ); +use vars qw( @ISA $DEBUG $me $conf @encrypted_fields + $unsuspendauto $ignore_noapply + ); use Date::Format; use Business::CreditCard; use Text::Template; -use FS::Misc qw(send_email); +use FS::UID qw( getotaker ); +use FS::Misc qw( send_email ); use FS::Record qw( dbh qsearch qsearchs ); +use FS::payby; use FS::cust_main_Mixin; use FS::payinfo_Mixin; use FS::cust_bill; @@ -17,6 +21,10 @@ use FS::cust_pay_void; @ISA = qw(FS::Record FS::cust_main_Mixin FS::payinfo_Mixin ); +$DEBUG = 0; + +$me = '[FS::cust_pay]'; + $ignore_noapply = 0; #ask FS::UID to run this stuff for us later @@ -58,11 +66,13 @@ currently supported: =item custnum - customer (see L) -=item paid - Amount of this payment - =item _date - specified as a UNIX timestamp; see L. Also see L and L for conversion functions. +=item paid - Amount of this payment + +=item otaker - order taker (assigned automatically, see L) + =item payby - Payment Type (See L for valid payby values) =item payinfo - Payment Information (See L for data format) @@ -388,11 +398,14 @@ returns the error, otherwise returns false. Called by the insert method. sub check { my $self = shift; + $self->otaker(getotaker) unless ($self->otaker); + my $error = $self->ut_numbern('paynum') || $self->ut_numbern('custnum') - || $self->ut_money('paid') || $self->ut_numbern('_date') + || $self->ut_money('paid') + || $self->ut_alpha('otaker') || $self->ut_textn('paybatch') || $self->ut_textn('payunique') || $self->ut_enum('closed', [ '', 'Y' ]) @@ -408,15 +421,16 @@ sub check { $self->_date(time) unless $self->_date; - # UNIQUE index should catch this too, without race conditions, but this - # should give a better error message the other 99.9% of the time... - if ( length($self->payunique) - && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) { - #well, it *could* be a better error message - return "duplicate transaction". - " - a payment with unique identifer ". $self->payunique. - " already exists"; - } +#i guess not now, with cust_pay_pending, if we actually make it here, we _do_ want to record it +# # UNIQUE index should catch this too, without race conditions, but this +# # should give a better error message the other 99.9% of the time... +# if ( length($self->payunique) +# && qsearchs('cust_pay', { 'payunique' => $self->payunique } ) ) { +# #well, it *could* be a better error message +# return "duplicate transaction". +# " - a payment with unique identifer ". $self->payunique. +# " already exists"; +# } $self->SUPER::check; } @@ -548,6 +562,74 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +=item payby_name + +Returns a name for the payby field. + +=cut + +sub payby_name { + my $self = shift; + FS::payby->shortname( $self->payby ); +} + +=item gatewaynum + +Returns a gatewaynum for the processing gateway. + +=item processor + +Returns a name for the processing gateway. + +=item authorization + +Returns a name for the processing gateway. + +=item order_number + +Returns a name for the processing gateway. + +=cut + +sub gatewaynum { shift->_parse_paybatch->{'gatewaynum'}; } +sub processor { shift->_parse_paybatch->{'processor'}; } +sub authorization { shift->_parse_paybatch->{'authorization'}; } +sub order_number { shift->_parse_paybatch->{'order_number'}; } + +#sucks that this stuff is in paybatch like this in the first place, +#but at least other code can start to use new field names +#(code nicked from FS::cust_main::realtime_refund_bop) +sub _parse_paybatch { + my $self = shift; + + $self->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/ + or return {}; + #"Can't parse paybatch for paynum $options{'paynum'}: ". + # $cust_pay->paybatch; + + my( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 ); + + if ( $gatewaynum ) { #gateway for the payment to be refunded + + my $payment_gateway = + qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } ); + + die "payment gateway $gatewaynum not found" #? + unless $payment_gateway; + + $processor = $payment_gateway->gateway_module; + + } + + { + 'gatewaynum' => $gatewaynum, + 'processor' => $processor, + 'authorization' => $auth, + 'order_number' => $order_number, + }; + +} + =back =head1 CLASS METHODS @@ -578,6 +660,210 @@ sub unapplied_sql { } +# _upgrade_data +# +# Used by FS::Upgrade to migrate to a new database. + +use FS::h_cust_pay; + +sub _upgrade_data { #class method + my ($class, %opts) = @_; + + warn "$me upgrading $class\n" if $DEBUG; + + #not the most efficient, but hey, it only has to run once + + my $where = "WHERE otaker IS NULL OR otaker = '' OR otaker = 'ivan' "; + + my $count_sql = "SELECT COUNT(*) FROM cust_pay $where"; + + my $sth = dbh->prepare($count_sql) or die dbh->errstr; + $sth->execute or die $sth->errstr; + my $total = $sth->fetchrow_arrayref->[0]; + + local($DEBUG) = 2 if $total > 1000; #could be a while, force progress info + + my $count = 0; + my $lastprog = 0; + while (1) { + + my $cust_pay = qsearchs( { + 'table' => 'cust_pay', + 'hashref' => {}, + 'extra_sql' => $where, + 'order_by' => 'ORDER BY paynum LIMIT 1', + } ); + + return unless $cust_pay; + + my $h_cust_pay = $cust_pay->h_search('insert'); + if ( $h_cust_pay ) { + $cust_pay->otaker($h_cust_pay->history_user); + } else { + $cust_pay->otaker('legacy'); + } + + delete $FS::payby::hash{'COMP'}->{cust_pay}; #quelle kludge + my $error = $cust_pay->replace; + die $error if $error; + $FS::payby::hash{'COMP'}->{cust_pay} = ''; #restore it + + $count++; + if ( $DEBUG > 1 && $lastprog + 30 < time ) { + warn "$me $count/$total (". sprintf('%.2f',100*$count/$total). '%)'. "\n"; + $lastprog = time; + } + + } + +} + +=back + +=head1 SUBROUTINES + +=over 4 + +=item batch_import HASHREF + +Inserts new payments. + +=cut + +sub batch_import { + my $param = shift; + + my $fh = $param->{filehandle}; + my $agentnum = $param->{agentnum}; + my $format = $param->{'format'}; + my $paybatch = $param->{'paybatch'}; + + # here is the agent virtualization + my $extra_sql = ' AND '. $FS::CurrentUser::CurrentUser->agentnums_sql; + + my @fields; + my $payby; + if ( $format eq 'simple' ) { + @fields = qw( custnum agent_custid paid payinfo ); + $payby = 'BILL'; + } elsif ( $format eq 'extended' ) { + die "unimplemented\n"; + @fields = qw( ); + $payby = 'BILL'; + } else { + die "unknown format $format"; + } + + eval "use Text::CSV_XS;"; + die $@ if $@; + + my $csv = new Text::CSV_XS; + + my $imported = 0; + + 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 $line; + while ( defined($line=<$fh>) ) { + + $csv->parse($line) or do { + $dbh->rollback if $oldAutoCommit; + return "can't parse: ". $csv->error_input(); + }; + + my @columns = $csv->fields(); + + my %cust_pay = ( + payby => $payby, + paybatch => $paybatch, + ); + + my $cust_main; + foreach my $field ( @fields ) { + + if ( $field eq 'agent_custid' + && $agentnum + && $columns[0] =~ /\S+/ ) + { + + my $agent_custid = $columns[0]; + my %hash = ( 'agent_custid' => $agent_custid, + 'agentnum' => $agentnum, + ); + + if ( $cust_pay{'custnum'} !~ /^\s*$/ ) { + $dbh->rollback if $oldAutoCommit; + return "can't specify custnum with agent_custid $agent_custid"; + } + + $cust_main = qsearchs({ + 'table' => 'cust_main', + 'hashref' => \%hash, + 'extra_sql' => $extra_sql, + }); + + unless ( $cust_main ) { + $dbh->rollback if $oldAutoCommit; + return "can't find customer with agent_custid $agent_custid"; + } + + $field = 'custnum'; + $columns[0] = $cust_main->custnum; + } + + $cust_pay{$field} = shift @columns; + } + + my $cust_pay = new FS::cust_pay( \%cust_pay ); + my $error = $cust_pay->insert; + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't insert payment for $line: $error"; + } + + if ( $format eq 'simple' ) { + # include agentnum for less surprise? + $cust_main = qsearchs({ + 'table' => 'cust_main', + 'hashref' => { 'custnum' => $cust_pay->custnum }, + 'extra_sql' => $extra_sql, + }) + unless $cust_main; + + unless ( $cust_main ) { + $dbh->rollback if $oldAutoCommit; + return "can't find customer to which payments apply at line: $line"; + } + + $error = $cust_main->apply_payments_and_credits; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't apply payments to customer for $line: $error"; + } + + } + + $imported++; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + return "Empty file!" unless $imported; + + ''; #no error + +} + =back =head1 BUGS @@ -586,8 +872,8 @@ Delete and replace methods. =head1 SEE ALSO -L, L, L, schema.html from the -base documentation. +L, L, L, L, +schema.html from the base documentation. =cut