#!/usr/bin/perl
-# $Id: bop.t,v 1.3 2006-08-30 18:48:40 plobbes Exp $
+# $Id: bop.t,v 1.7 2006-11-20 04:54:24 plobbes Exp $
use strict;
use warnings;
-use Test::More tests => 49;
+use Test::More tests => 62;
BEGIN { use_ok("Business::OnlinePayment") or exit; }
-{ # fake test driver 1
+{ # fake test driver 1 (no submit method)
package Business::OnlinePayment::MOCK1;
use strict;
use base qw(Business::OnlinePayment);
}
+{ # fake test driver 2 (with submit method that dies)
+
+ package Business::OnlinePayment::MOCK2;
+ use strict;
+ use warnings;
+ use base qw(Business::OnlinePayment);
+ sub submit { die("in processor submit\n"); }
+}
+
+{ # fake test driver 3 (with submit method)
+
+ package Business::OnlinePayment::MOCK3;
+ use strict;
+ use warnings;
+ use base qw(Business::OnlinePayment);
+ sub submit { return (1); }
+}
+
my $package = "Business::OnlinePayment";
-my $driver = "MOCK1";
+my @drivers = qw(MOCK1 MOCK2 MOCK3);
+my $driver = $drivers[0];
# trick to make use() happy (called in Business::OnlinePayment->new)
-$INC{"Business/OnlinePayment/${driver}.pm"} = "testing";
+foreach my $drv (@drivers) {
+ $INC{"Business/OnlinePayment/${drv}.pm"} = "testing";
+}
{ # new
can_ok( $package, qw(new) );
# XXX
# { # _risk_detect }
-# { # _pre_submit }
+
+{ # _pre_submit
+
+ my $s_orig = Business::OnlinePayment::MOCK3->can("submit");
+ is( ref $s_orig, "CODE", "MOCK3 submit code ref $s_orig" );
+
+ # test to ensure we do not go recursive when wrapping submit
+ my $obj1 = $package->new("MOCK3");
+ my $s_new1 = $obj1->can("submit");
+
+ isnt( $s_new1, $s_orig, "MOCK3 submit code ref $s_new1 (wrapped)" );
+ is( $obj1->submit, "1", "MOCK3(obj1) submit returns 1" );
+
+ my $obj2 = $package->new("MOCK3");
+ my $s_new2 = $obj2->can("submit");
+ is( $obj2->submit, "1", "MOCK3(obj2) submit returns 1" );
+
+ # fraud detection failure modes
+ my $obj = $package->new("MOCK3");
+ my $bogus = "__BOGUS_PROCESSOR";
+ my $valid = "preCharge";
+
+ is( $obj->fraud_detect($bogus), $bogus, "fraud_detect set to '$bogus'" );
+ eval { $obj->submit; };
+ is( $@, "", "fraud_detect ignores non-existant processors" );
+
+ is( $obj->fraud_detect($valid), $valid, "fraud_detect set to '$valid'" );
+ eval { $obj->submit; };
+ like( $@, qr/^missing required /, "fraud_detect($valid) missing fields" );
+
+ # XXX: more test cases for preCharge needed
+}
{ # content
my $obj;
is( $obj->required_fields, 0, "no required fields" );
eval { $obj->required_fields("field1"); };
- like( $@, qr/^missing required field/, "missing required_fields() croaks" );
+ like( $@, qr/^missing required field/, "missing required_fields croaks" );
}
{ # get_fields
can_ok( $package, qw(submit) );
can_ok( $obj, qw(submit) );
- # XXX
- # eval { $obj->submit; };
- # like( $@, qr/^Processor subclass did not /, "missing submit() croaks" );
- #Tests turned off due to bug:
- # Deep recursion on anonymous subroutine
- # at .../Business/OnlinePayment.pm line 110.
- # Deep recursion on subroutine "Business::OnlinePayment::_pre_submit"
- # at .../Business/OnlinePayment.pm line 74.
+ eval { $obj->submit; };
+ like( $@, qr/^Processor subclass did not /, "missing submit() croaks" );
+ is( $obj->can("submit"), $package->can("submit"), "submit unchanged" );
+
+ my $mock2 = $package->new("MOCK2");
+ can_ok( $mock2, qw(submit) );
+
+ isnt( $mock2->can("submit"), $package->can("submit"), "submit changed" );
+ eval { $mock2->submit; };
+ like( $@, qr/^in processor submit/, "processor submit() is called" );
}
{ # dump_contents