- created test cases for (all?) methods except _risk_detect _pre_submit

diff --git a/t/bop.t b/t/bop.t
index 78526b6..995fcad 100644 (file)
--- a/t/bop.t
+++ b/t/bop.t
@@ -1,9 +1,195 @@
-# test 1
-BEGIN { $| = 1; print "1..1\n"; }
-END {print "not ok 1\n" unless $loaded;}
+#!/usr/bin/perl
+# $Id: bop.t,v 1.2 2006-08-30 18:29:59 plobbes Exp $
 
-use Business::OnlinePayment;
-$loaded = 1;
-print "ok 1\n";
+use strict;
+use warnings;
+use Test::More tests => 49;
 
+BEGIN { use_ok("Business::OnlinePayment") or exit; }
 
+{    # fake test driver 1
+
+    package Business::OnlinePayment::MOCK1;
+    use strict;
+    use warnings;
+    use base qw(Business::OnlinePayment);
+}
+
+my $package = "Business::OnlinePayment";
+my $driver  = "MOCK1";
+
+# trick to make use() happy (called in Business::OnlinePayment->new)
+$INC{"Business/OnlinePayment/${driver}.pm"} = "testing";
+
+{    # new
+    can_ok( $package, qw(new) );
+    my $obj;
+
+    eval { $obj = $package->new(); };
+    like( $@, qr/^unspecified processor/, "new() without a processor croaks" );
+
+    eval { $obj = $package->new("__BOP BOGUS PROCESSOR__"); };
+    like( $@, qr/^unknown processor/,
+        "new() with an unknown processor croaks" );
+
+    $obj = $package->new($driver);
+    isa_ok( $obj, $package );
+    isa_ok( $obj, $package . "::" . $driver );
+
+    # build_subs(%fields)
+    can_ok(
+        $obj, qw(
+          authorization
+          error_message
+          failure_status
+          fraud_detect
+          is_success
+          maximum_risk
+          path
+          port
+          require_avs
+          result_code
+          server
+          server_response
+          test_transaction
+          transaction_type
+          )
+    );
+
+    # new (via build_subs) automatically creates accessors for arguments
+    $obj = $package->new( $driver, "proc1" => "value1" );
+    can_ok( $package, "proc1" );
+    can_ok( $obj,     "proc1" );
+
+    # new (via build_subs) automatically creates accessors for arguments
+    $obj = $package->new( $driver, qw(key1 v1 Key2 v2 -Key3 v3 --KEY4 v4) );
+    can_ok( $package, qw(key1 key2 key3 key4) );
+    can_ok( $obj,     qw(key1 key2 key3 key4) );
+
+    # new makes all accessors lowercase and removes leading dash(es)
+    is( $obj->key1, "v1", "value of key1   (method key1) is v1" );
+    is( $obj->key2, "v2", "value of Key2   (method key2) is v2" );
+    is( $obj->key3, "v3", "value of -Key3  (method key3) is v3" );
+    is( $obj->key4, "v4", "value of --KEY4 (method key4) is v4" );
+}
+
+# XXX
+# {    # _risk_detect }
+# {    # _pre_submit }
+
+{    # content
+    my $obj;
+
+    $obj = $package->new($driver);
+    can_ok( $package, qw(content) );
+    can_ok( $obj,     qw(content) );
+
+    is( $obj->content, (), "default content is empty" );
+
+    my %data = qw(k1 v1 type test -k2 v2 K3 v3);
+    is_deeply( { $obj->content(%data) }, \%data, "content is set properly" );
+    is( $obj->transaction_type, "test", "content sets transaction_type" );
+
+    %data = ( type => undef );
+    is_deeply( { $obj->content(%data) }, \%data, "content with type=>undef" );
+    is( $obj->transaction_type, "test", "transaction_type not reset" );
+}
+
+{    # required_fields
+    my $obj = $package->new($driver);
+    can_ok( $package, qw(required_fields) );
+    can_ok( $obj,     qw(required_fields) );
+
+    is( $obj->required_fields, undef, "no required fields" );
+
+    eval { $obj->required_fields("field1"); };
+    like( $@, qr/^missing required field/, "missing required_fields() croaks" );
+}
+
+{    # get_fields
+    my $obj = $package->new($driver);
+    can_ok( $package, qw(get_fields) );
+    can_ok( $obj,     qw(get_fields) );
+
+    my %data = ( a => 1, b => 2, c => undef, d => 4 );
+    $obj->content(%data);
+
+    my ( @want, %get );
+
+    @want = qw(a b);
+    %get = map { $_ => $data{$_} } @want;
+    is_deeply( { $obj->get_fields(@want) },
+        \%get, "get_fields with defined vals" );
+
+    @want = qw(a c d);
+    %get = map { defined $data{$_} ? ( $_ => $data{$_} ) : () } @want;
+
+    is_deeply( { $obj->get_fields(@want) },
+        \%get, "get_fields does not get fields with undef values" );
+}
+
+{    # remap_fields
+    my $obj = $package->new($driver);
+    can_ok( $package, qw(remap_fields) );
+    can_ok( $obj,     qw(remap_fields) );
+
+    my %data = ( a => 1, b => 2, c => undef, d => 4 );
+    $obj->content(%data);
+
+    my %map = ( a => "Aa", d => "Dd" );
+    my %get = ( a => 1, Aa => 1, b => 2, c => undef, d => 4, Dd => 4 );
+
+    $obj->remap_fields(%map);
+    is_deeply( { $obj->content }, \%get, "remap_fields" );
+}
+
+{    # submit
+    my $obj = $package->new($driver);
+    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.
+}
+
+{    # dump_contents
+    my $obj = $package->new($driver);
+    can_ok( $package, qw(dump_contents) );
+    can_ok( $obj,     qw(dump_contents) );
+}
+
+{    # build_subs
+    my $obj;
+
+    $obj = $package->new($driver);
+    can_ok( $package, qw(build_subs) );
+    can_ok( $obj,     qw(build_subs) );
+
+    # build_subs creates accessors for arguments
+    my %data = qw(key1 v1 Key2 v2 -Key3 v3 --KEY4 v4);
+    my @subs =
+      sort { lc( ( $a =~ /(\w+)/ )[0] ) cmp lc( ( $b =~ /(\w+)/ )[0] ) }
+      keys %data;
+
+    $obj->build_subs(@subs);
+
+    # perl does not allow dashes ("-") in subroutine names
+    foreach my $sub (@subs) {
+        if ( $sub !~ /^\w+/ ) {
+            is( ref $package->can($sub), "", "$package can NOT $sub" );
+            is( ref $obj->can($sub),     "", ref($obj) . " can NOT $sub" );
+        }
+        else {
+            can_ok( $package, $sub );
+            can_ok( $obj,     $sub );
+            $obj->$sub( $data{$sub} );
+            is( $obj->$sub, $data{$sub}, "$sub accessor returns $data{$sub}" );
+        }
+    }
+}