File Coverage

blib/lib/Business/OnlinePayment/MerchantCommerce.pm

Criterion	Covered	Total	%
statement	12	108	11.1
branch	0	50	0.0
condition	0	24	0.0
subroutine	4	10	40.0
pod	1	2	50.0
total	17	194	8.7

line	stmt	bran	cond	sub	pod	time	code
1							package Business::OnlinePayment::MerchantCommerce;
2
3	1			1		968	use strict;
	1					3
	1					54
4	1			1		5	use Carp;
	1					2
	1					91
5	1			1		1784	use Net::SSLeay qw/make_form post_https/;
	1					26815
	1					1901
6	1			1		9	use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
	1					1
	1					1454
7
8							require Exporter;
9
10							@ISA = qw(Exporter AutoLoader Business::OnlinePayment);
11							@EXPORT = qw();
12							@EXPORT_OK = qw();
13							$VERSION = 0.01;
14
15							sub set_defaults {
16	0			0	0		my ($self) = @_;
17	0						$self->server('trans.atsbank.com');
18	0						$self->port('443');
19	0						$self->path('/cgi-bin/ats.cgi');
20							}
21
22							sub _action {
23	0			0			my ($self, $action) = @_;
24
25	0						my %content = $self->content();
26
27	0						$content{_action} = $content{action};
28	0						delete $content{action};
29
30	0						for
31							(
32							'normal authorization','authorization only',
33							'post authorization','ns_quicksale_cc',
34							'visa','mastercard','american express','discover'
35							)
36							{
37	0	0	0				$content{action} = 'ns_quicksale_cc'
38							if $content{_action} eq $_
39							or $content{type} eq $_;
40							}
41
42	0	0					unless ( $content{action} ) {
43	0						for ('check','ns_quicksale_check') {
44	0	0	0				$content{action} = 'ns_quicksale_check'
45							if $content{_action} eq $_
46							or $content{type} eq $_;
47							}
48							}
49
50	0	0					if ( $content{action} eq 'ns_quicksale_cc' ) {
		0
51	0	0					if ( ! $content{_action} ) {
52	0	0					if ( $content{type} =~ /^(post authorization\|authorization only)$/ ) {
53	0						$content{_action} = $content{type};
54							}
55							else {
56	0						$content{_action} = 'normal authorization';
57							}
58							}
59							}
60							elsif ( $content{action} eq 'ns_quicksale_check' ) {
61	0						$content{_action} = 'check';
62							}
63
64	0	0					Carp::croak('Specified action or type not supported by Merchant Commerce')
65							unless $content{action};
66
67	0						$self->content(%content);
68							}
69
70							sub _map {
71	0			0			my ($self) = @_;
72	0						my %content = $self->content;
73
74	0	0					my %map = (name => $content{action} eq 'ns_quicksale_cc' ? 'ccname' : 'ckname',
75							login => 'acctid',
76							description => 'ci_memo',
77							address => 'ci_billaddr1',
78							city => 'ci_billcity',
79							state => 'ci_billstate',
80							zip => 'ci_billzip',
81							country => 'ci_billcountry',
82							phone => 'ci_phone',
83							email => 'ci_email',
84							card_number => 'ccnum',
85							account_number => 'ckacct',
86							routing_code => 'ckaba');
87
88	0						while ( my($base_identifier, $mc_identifier) = each (%map) ) {
89	0	0					if (defined $content{$base_identifier}) {
90	0						$content{$mc_identifier} = $content{$base_identifier};
91							}
92							}
93
94	0						$self->content(%content);
95							}
96
97
98
99							sub _required {
100	0			0			my ($self) = @_;
101
102	0	0					Carp::croak('require_avs function not supported by Merchant Commerce')
103							if $self->require_avs;
104
105	0						my %content = $self->content;
106	0						my $test = $self->test_transaction;
107
108	0	0					if ( $test ) {
109	0						$content{acctid} = 'TEST0';
110							}
111
112	0	0					if ( $content{action} eq 'ns_quicksale_cc' ) {
113	0						($content{expmon}, $content{expyear}) = $self->_date(\%content);
114	0	0					if ( $test ) {
115	0						$self->required_fields(qw~ccname~);
116	0						$content{'ccnum'} = '5454545454545454';
117							}
118							else {
119	0						$self->required_fields(qw~ccname ccnum~);
120							}
121							}
122
123	0	0					if ( $content{_action} eq 'authorization only' ) {
		0
		0
124	0						$self->build_subs('authrefcode');
125	0						$content{authonly} = 1;
126							}
127							elsif ( $content{_action} eq 'post authorization' ) {
128	0						$self->build_subs('authrefcode');
129	0						$self->required_fields(qw~authrefcode~);
130							}
131							elsif ( $content{_action} eq 'check' ) {
132	0						$self->required_fields(qw~ckname ckacct ckaba~);
133							}
134
135	0						$self->content(%content);
136	0						$self->required_fields(qw~acctid amount~);
137							}
138
139							sub _date {
140	0			0			my ($self, $content) = @_;
141
142	0	0	0				if ( !($content->{expmon} and $content->{expyear}) and $content->{exp_date} ) {
			0
143	0						($content->{expmon}, $content->{expyear}) = split /\//, $content->{exp_date};
144							}
145	0	0	0				Carp::croak('Merchant Commerce requires exp_date(mm/yyyy) or expmon(mm) and expyear(yyyy)')
146							unless $content->{expmon} and $content->{expyear};
147
148	0						$content->{expmon}, $content->{expyear};
149							}
150
151							sub submit {
152	0			0	1		my($self) = @_;
153
154	0						$self->_action;
155	0						$self->_map;
156	0						$self->_required;
157
158	0						my %post_data = $self->get_fields(qw~ckname ckacct ckaba
159							ccname ccnum expmon expyear authonly authrefcode
160							acctid action amount subid usepost
161							ci_companyname ci_phone ci_email ci_memo ci_dlnum ci_ssnum
162							ci_billaddr1 ci_billaddr2 ci_billcity ci_billstate ci_billzip ci_billcountry
163							ci_shipaddr1 ci_shipaddr2 ci_shipcity ci_shipstate ci_shipzip ci_shipcountry
164							emailto emailfrom emailsubject emailtext
165							recur_create recur_billingcycle recur_billingmax recur_start recur_amount~);
166
167	0						while (my ($key,$value) = each (%post_data)) {
168	0	0					delete $post_data{$key} unless defined $post_data{$key};
169							}
170
171	0						my $query = make_form(%post_data);
172	0						my $server = $self->server;
173	0						my $port = $self->port;
174	0						my $path = $self->path;
175
176	0						$self->build_subs(qw/response_headers server_status accepted
177							historyid orderid refcode unknown_result_code
178							unknown_response_format unknown_methods
179							declined error post_data conversation
180							server_response/);
181
182	0						my ($content,$server_status,%headers) = post_https($server,$port,$path,'',$query);
183
184	0						$self->post_data(\%post_data);
185	0						$self->server_status($server_status);
186	0						$self->server_response($content);
187	0						$self->response_headers(\%headers);
188
189	0						my @post_data = map { "$_ => $post_data{$_}" } keys %post_data;
	0
190	0						my @headers = map { "$_: $headers{$_}" } keys %headers;
	0
191	0						my $conversation = join "\n", @post_data,
192							$server_status,
193							@headers,
194							$content;
195	0						$self->conversation($conversation);
196	0						my $response_format = $content =~ s/^//; </td> </tr> <tr> <td class="h" > <a name="197">197</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> chomp $content; </td> </tr> <tr> <td class="h" > <a name="198">198</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="199">199</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Business-OnlinePayment-MerchantCommerce-pm--branch.html#199-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ( $response_format ) { </td> </tr> <tr> <td class="h" > <a name="200">200</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="201">201</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my @unknown_methods = (); </td> </tr> <tr> <td class="h" > <a name="202">202</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> for ( split /\n/, $content ) { </td> </tr> <tr> <td class="h" > <a name="203">203</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> my ($meth, $val) = split /=/, lc $_; </td> </tr> <tr> <td class="h" > <a name="204">204</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Business-OnlinePayment-MerchantCommerce-pm--branch.html#204-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> unless ( $self->can($meth) ) { </td> </tr> <tr> <td class="h" > <a name="205">205</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->build_subs($meth); </td> </tr> <tr> <td class="h" > <a name="206">206</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> push @unknown_methods, $meth; </td> </tr> <tr> <td class="h" > <a name="207">207</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="208">208</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->$meth($val); </td> </tr> <tr> <td class="h" > <a name="209">209</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="210">210</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Business-OnlinePayment-MerchantCommerce-pm--branch.html#210-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->unknown_functions(\@unknown_methods) </td> </tr> <tr> <td class="h" > <a name="211">211</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if defined $unknown_methods[0]; </td> </tr> <tr> <td class="h" > <a name="212">212</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="213">213</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-Business-OnlinePayment-MerchantCommerce-pm--condition.html#213-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->result_code($self->accepted \|\| $self->declined \|\| $self->error); </td> </tr> <tr> <td class="h" > <a name="214">214</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="215">215</a> </td> <td class="c0" > 0 </td> <td class="c0" > <a href="blib-lib-Business-OnlinePayment-MerchantCommerce-pm--branch.html#215-1"> 0 </a> </td> <td class="c0" > <a href="blib-lib-Business-OnlinePayment-MerchantCommerce-pm--condition.html#215-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> if ( $self->accepted ) { </td> </tr> <tr> <td class="h" > <a > </a> </td> <td >   </td> <td class="c0" > <a href="blib-lib-Business-OnlinePayment-MerchantCommerce-pm--branch.html#-2"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s">   </td> </tr> <tr> <td class="h" > <a name="216">216</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->is_success(1); </td> </tr> <tr> <td class="h" > <a name="217">217</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->authorization($self->accepted); </td> </tr> <tr> <td class="h" > <a name="218">218</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="219">219</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> elsif ( $self->declined \|\| $self->error ) { </td> </tr> <tr> <td class="h" > <a name="220">220</a> </td> <td class="c0" > 0 </td> <td >   </td> <td class="c0" > <a href="blib-lib-Business-OnlinePayment-MerchantCommerce-pm--condition.html#220-1"> 0 </a> </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->error_message($self->declined \|\| $self->error); </td> </tr> <tr> <td class="h" > <a name="221">221</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="222">222</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> else { </td> </tr> <tr> <td class="h" > <a name="223">223</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->unknown_result_code(1); </td> </tr> <tr> <td class="h" > <a name="224">224</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->error_message($conversation); </td> </tr> <tr> <td class="h" > <a name="225">225</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> }; </td> </tr> <tr> <td class="h" > <a name="226">226</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="227">227</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="228">228</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> else { </td> </tr> <tr> <td class="h" > <a name="229">229</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->unknown_response_format(1); </td> </tr> <tr> <td class="h" > <a name="230">230</a> </td> <td class="c0" > 0 </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> $self->error_message($conversation); </td> </tr> <tr> <td class="h" > <a name="231">231</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="232">232</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> } </td> </tr> <tr> <td class="h" > <a name="233">233</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="234">234</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> 1; </td> </tr> <tr> <td class="h" > <a name="235">235</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> </td> </tr> <tr> <td class="h" > <a name="236">236</a> </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td >   </td> <td class="s"> __END__ </td> </tr> </table> </body> </html>