File Coverage

blib/lib/Business/OnlinePayment.pm

Criterion	Covered	Total	%
statement	191	252	75.7
branch	52	92	56.5
condition			n/a
subroutine	45	57	78.9
pod	29	34	85.2
total	317	435	72.8

package Business::OnlinePayment;

use strict;
use vars qw($VERSION %_info_handler);
use Carp;

require 5.005;

$VERSION = '3.05';
$VERSION = eval $VERSION; # modperlstyle: convert the string into a number

# Remember subclasses we have "wrapped" submit() with _pre_submit()
my %Presubmit_Added = ();

my @methods = qw(
    authorization
    order_number
    error_message
    failure_status
    fraud_detect
    is_success
    partial_auth_amount
    maximum_risk
    path
    port
    require_avs
    result_code
    server
    server_response
    test_transaction
    transaction_type
    fraud_score
    fraud_transaction_id
    response_code
    response_header
    response_page
    avs_code
    cvv2_response
    txn_date
);

__PACKAGE__->build_subs(@methods);

#fallback
sub _info {
  my $class = shift;
  ( my $gw = $class ) =~ s/^Business::OnlinePayment:://;
  {
    'info_compat'    => '0.00',
    'gateway_name'   => $gw,
    'module_notes'   => "Module does not yet provide info.",
  };
}

#allow classes to declare info in a flexible way, but return normalized info
%_info_handler = (
  'supported_types'   => sub {
    my( $class, $v ) = @_;
    my $types = ref($v) ? $v : defined($v) ? [ $v ] : [];
    $types = { map { $_=>1 } @$types } if ref($types) eq 'ARRAY';
    $types;
  },
  'supported_actions' => sub {
    my( $class, $v ) = @_;
    return %$v if ref($v) eq 'HASH';
    $v = [ $v ] unless ref($v);
    my $types = $class->info('supported_types') || {};
    ( map { $_ => $v } keys %$types );
  },
);

sub info {
  my $class = shift; #class or object
  my $info = $class->_info;
  if ( @_ ) {
    my $key = shift;
    exists($_info_handler{$key})
      ? &{ $_info_handler{$key} }( $class, $info->{$key} )
      : $info->{$key};
  } else {
    wantarray ? ( keys %$info ) : [ keys %$info ];
  }
}

sub new {
    my($class,$processor,%data) = @_;

    croak("unspecified processor") unless $processor;

    my $subclass = "${class}::$processor";
    eval "use $subclass";
    croak("unknown processor $processor ($@)") if $@;

    my $self = bless {processor => $processor}, $subclass;

    if($self->can("set_defaults")) {
        $self->set_defaults(%data);
    }

    foreach(keys %data) {
        my $key = lc($_);
        my $value = $data{$_};
        $key =~ s/^\-+//;
        $self->build_subs($key);
        $self->$key($value);
    }

    # "wrap" submit with _pre_submit only once
    unless ( $Presubmit_Added{$subclass} ) {
        my $real_submit = $subclass->can('submit');

	no warnings 'redefine';
	no strict 'refs';

	*{"${subclass}::submit"} = sub {
	    my $self = shift;
	    return unless $self->_pre_submit(@_);
	    return $real_submit->($self, @_);
	}
    }

    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()) {
         $self->fraud_score( $risk_transaction->fraud_score );
         $self->fraud_transaction_id( $risk_transaction->fraud_transaction_id );
	if ( $risk_transaction->fraud_score <= $self->maximum_fraud_score()) {
	    return 1;
	} else {
	    $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);
    return 0;
}

my @Fraud_Class_Path = qw(Business::OnlinePayment Business::FraudDetect);

sub _pre_submit {
    my ($self) = @_;
    my $fraud_detection = $self->fraud_detect();

    # early return if user does not want optional risk mgt
    return 1 unless $fraud_detection;

    # Search for an appropriate FD module
    foreach my $fraud_class ( @Fraud_Class_Path ) {
	my $subclass = $fraud_class . "::" . $fraud_detection;
	eval "use $subclass ()";
	if ($@) {
	    croak("error loading fraud_detection module ($@)")
              unless ( $@ =~ m/^Can\'t locate/ );
        } else {
            my $risk_tx = bless( { processor => $fraud_detection }, $subclass );
            if ($risk_tx->can('set_defaults')) {
                $risk_tx->set_defaults();
            }
            $risk_tx->_glean_parameters_from_parent($self);
            return $self->_risk_detect($risk_tx);
	}
    }
    croak("Unable to locate fraud_detection module $fraud_detection"
		. " in \@INC under Fraud_Class_Path (\@Fraud_Class_Path"
	        . " contains: @Fraud_Class_Path) (\@INC contains: @INC)");
}

sub content {
    my($self,%params) = @_;

    if(%params) {
        if($params{'type'}) { $self->transaction_type($params{'type'}); }
        %{$self->{'_content'}} = %params;
    }
    return exists $self->{'_content'} ? %{$self->{'_content'}} : ();
}

sub required_fields {
    my($self,@fields) = @_;

    my @missing;
    my %content = $self->content();
    foreach(@fields) {
        push(@missing, $_) unless exists $content{$_};
    }

    croak("missing required field(s): " . join(", ", @missing) . "\n")
	  if(@missing);
}

sub get_fields {
    my($self, @fields) = @_;

    my %content = $self->content();

    #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( keys %map ) {
        $content{$map{$_}} = $content{$_};
    }
    $self->content(%content);
}

sub submit {
    my($self) = @_;

    croak("Processor subclass did not override submit function");
}

sub dump_contents {
    my($self) = @_;

    my %content = $self->content();
    my $dump = "";
    foreach(sort keys %content) {
        $dump .= "$_ = $content{$_}\n";
    }
    return $dump;
}

# didnt use AUTOLOAD because Net::SSLeay::AUTOLOAD passes right to
# AutoLoader::AUTOLOAD, instead of passing up the chain
sub build_subs {
    my $self = shift;

    foreach(@_) {
        next if($self->can($_));
        eval "sub $_ { my \$self = shift; if(\@_) { \$self->{$_} = shift; } return \$self->{$_}; }";
    }
}

#helper method

sub silly_bool {
  my( $self, $value ) = @_;
  return 1 if $value =~ /^[yt]/i;
  return 0 if $value =~ /^[fn]/i;
  #return 1 if $value == 1;
  #return 0 if $value == 0;
  $value; #die??
}

1;

__END__