From: plobbes Date: Wed, 30 Aug 2006 18:29:59 +0000 (+0000) Subject: - created test cases for (all?) methods except _risk_detect _pre_submit X-Git-Tag: BUSINESS_ONLINEPAYMENT_3_00_04~14 X-Git-Url: http://git.freeside.biz/gitweb/?p=Business-OnlinePayment.git;a=commitdiff_plain;h=777166d3e32e0fc5aeb5eb84731e02852831cba9 - 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 --- 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}" ); + } + } +}