New modules for preCharge
[Business-OnlinePayment.git] / OnlinePayment.pm
index 3262436..2e9d35d 100644 (file)
@@ -1,21 +1,28 @@
 package Business::OnlinePayment;
 
 use strict;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use vars qw($VERSION); # @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+use Symbol;
 
-require 5.004;
-require Exporter;
+require 5.005;
+##use Data::Dumper;
 
-@ISA = qw(Exporter AutoLoader);
-@EXPORT = qw();
-@EXPORT_OK = qw();
+#require Exporter;
 
-$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d"x$#r,@r};
+#@ISA = (); #qw(Exporter AutoLoader);
+#@EXPORT = qw();
+#@EXPORT_OK = qw();
 
-use Carp();
+$VERSION = '3.00_04';
+sub VERSION { #Argument "3.00_01" isn't numeric in subroutine entry
+  local($^W)=0;
+  UNIVERSAL::VERSION(@_);
+}
 
 my %fields = (
     is_success       => undef,
+    failure_status   => undef,
     result_code      => undef,
     test_transaction => undef,
     require_avs      => undef,
@@ -25,11 +32,15 @@ my %fields = (
     server           => undef,
     port             => undef,
     path             => undef,
+    risk_management  => undef,
+    risk_management_params => undef,         
     server_response  => undef,
+    maximum_risk     => undef,
 );
 
 
 sub new {
+
     my($class,$processor,%data) = @_;
 
     Carp::croak("unspecified processor") unless $processor;
@@ -55,9 +66,84 @@ sub new {
         $self->$key($value);
     }
 
+    {
+       no strict 'refs';
+       no warnings 'redefine';
+       my $submit = qualify_to_ref('submit', $subclass);
+       $self->{_child_submit} = \&$submit;
+       *{"${subclass}::submit"} = sub {
+           my $self = shift;
+           $self->_pre_submit(@_);
+
+       }
+    }
+
     return $self;
 }
 
+sub _risk_detect {
+    my ($self, $risk_transaction) = @_;
+
+    my %parent_content = $self->content();
+    $parent_content{action} = 'Fraud Detect';
+    $risk_transaction->content( %parent_content ); 
+    $risk_transaction->submit();
+    if ($risk_transaction->is_success()) {
+       if ( $risk_transaction->risk_level <= $self->maximum_risk()) {
+           $self->{_child_submit}->($self);
+       } else {
+           $self->is_success(0);
+           $self->error_message('Excessive risk from risk management');
+       }
+    } else {
+       $self->error_message('Error in risk detection stage: ' .  $risk_transaction->error_message);
+       $self->is_success(0);
+    }
+}
+
+sub _pre_submit{
+    my ($self) = @_;
+    my $risk_detection = $self->risk_management();
+
+    #
+    # early return if user does not want optional risk mgt
+    #
+
+    return $self->{_child_submit}->($self,@_) unless $risk_detection && length $risk_detection;
+
+    #
+
+    # Search for an appropriate FD module
+    #
+    
+    foreach my $subclass ( q(Business::OnlinePayment::) . $risk_detection,
+                          q(Business::FraudDetect::).$risk_detection) {
+
+       if (!defined(&$subclass)) {
+           eval "use $subclass";
+           if ($@) {
+               Carp::croak("serious problem loading risk_detection module ($@)") unless
+                   $@ =~ m/^Can\'t locate/;
+           } else {
+               my $risk_tx = bless ( { processor => $risk_detection } , $subclass );
+               $risk_tx->build_subs(keys %fields);
+               if ($risk_tx->can('set_defaults')) {
+                   $risk_tx->set_defaults();
+               }
+               my %risk_params = %{$self->risk_management_params()};
+               foreach my $key ( keys %risk_params ) {
+                   my $value = $risk_params{$key};
+                   $key = lc($key);
+                   $key =~ s/^\-//;
+                   $risk_tx->build_subs($key);
+                   $risk_tx->$key($value);
+               }
+               return $self->_risk_detect($risk_tx);
+           }
+       }
+    }
+};
+
 sub content {
     my($self,%params) = @_;
 
@@ -78,19 +164,21 @@ sub required_fields {
 }
 
 sub get_fields {
-    my($self,@fields) = @_;
+    my($self, @fields) = @_;
 
     my %content = $self->content();
-    my %new = ();
-    foreach(@fields) { $new{$_} = $content{$_}; }
-    return %new;
+
+    #my %new = ();
+    #foreach(@fields) { $new{$_} = $content{$_}; }
+    #return %new;
+    map { $_ => $content{$_} } grep defined $content{$_}, @fields;
 }
 
 sub remap_fields {
     my($self,%map) = @_;
 
     my %content = $self->content();
-    foreach(%map) {
+    foreach( keys %map ) {
         $content{$map{$_}} = $content{$_};
     }
     $self->content(%content);
@@ -117,6 +205,7 @@ sub dump_contents {
 # AutoLoader::AUTOLOAD, instead of passing up the chain
 sub build_subs {
     my $self = shift;
+    no warnings 'redefine';
     foreach(@_) {
         eval "sub $_ { my \$self = shift; if(\@_) { \$self->{$_} = shift; } return \$self->{$_}; }";
     }
@@ -266,6 +355,17 @@ Submit the transaction to the processor for completion
 
 Returns true if the transaction was submitted successfully, false if it failed (or undef if it has not been submitted yet).
 
+=head2 failure_status();
+
+If the transactdion failed, it can optionally return a specific failure status
+(normalized, not gateway-specific).  Currently defined statuses are: "expired",
+"nsf" (non-sufficient funds), "stolen", "pickup", "blacklisted" and
+"declined" (card/transaction declines only, not other errors).
+
+Note that (as of Aug 2006) this is only supported by some of the newest
+processor modules, and that, even if supported, a failure status is an entirely
+optional field that is only set for specific kinds of failures.
+
 =head2 result_code();
 
 Returns the precise result code that the processor returned, these are normally one letter codes that don't mean much unless you understand the protocol they speak, you probably don't need this, but it's there just in case.
@@ -302,10 +402,12 @@ Retrieve or change the processor submission port (CHANGE AT YOUR OWN RISK).
 
 Retrieve or change the processor submission path (CHANGE AT YOUR OWN RISK).
 
-=head1 AUTHOR
+=head1 AUTHORS
 
 Jason Kohles, email@jasonkohles.com
 
+(v3 rewrite) Ivan Kohler <ivan-business-onlinepayment@420.am>
+
 =head1 DISCLAIMER
 
 THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
@@ -315,6 +417,8 @@ MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
 
 =head1 SEE ALSO
 
+http://420.am/business-onlinepayment/
+
 For verification of credit card checksums, see L<Business::CreditCard>.
 
 =cut