New modules for preCharge
authorlawrence <lawrence>
Wed, 16 Aug 2006 23:44:36 +0000 (23:44 +0000)
committerlawrence <lawrence>
Wed, 16 Aug 2006 23:44:36 +0000 (23:44 +0000)
FraudDetect.pm [new file with mode: 0644]
OnlinePayment.pm

diff --git a/FraudDetect.pm b/FraudDetect.pm
new file mode 100644 (file)
index 0000000..834e135
--- /dev/null
@@ -0,0 +1,10 @@
+package Business::FraudDetect;
+
+
+
+use vars qw / $VERSION @ISA /;
+
+$VERSION = '0.01';
+@ISA = qw / Business::OnlinePayment /;
+
+1;
index 6d06887..2e9d35d 100644 (file)
@@ -3,8 +3,11 @@ package Business::OnlinePayment;
 use strict;
 use vars qw($VERSION); # @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
 use Carp;
+use Symbol;
 
 require 5.005;
+##use Data::Dumper;
+
 #require Exporter;
 
 #@ISA = (); #qw(Exporter AutoLoader);
@@ -29,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;
@@ -59,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) = @_;