File Coverage

blib/lib/Business/OnlinePayment/Cardcom.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Business::OnlinePayment::Cardcom;
2              
3 1     1   1644 use strict;
  1         1  
  1         45  
4 1     1   6 use Carp;
  1         2  
  1         97  
5 1     1   1241 use Tie::IxHash;
  1         6509  
  1         32  
6 1     1   2152 use Business::OnlinePayment 3;
  0            
  0            
7             use Business::OnlinePayment::HTTPS 0.03;
8             #use Data::Dumper;
9             use vars qw($VERSION $DEBUG @ISA);
10              
11             @ISA = qw(Business::OnlinePayment::HTTPS);
12             $VERSION = '0.02';
13             $DEBUG = 0;
14              
15             sub set_defaults {
16             my $self = shift;
17              
18             $self->server('secure.cardcom.co.il');
19             $self->path('/BillGoldPost.aspx');
20             $self->port('443');
21             }
22              
23             # XXX?
24             # -Identity number
25             # -Configurable currency
26             # -Configurable deal code
27             sub submit {
28             my($self) = @_;
29              
30             #warn Dumper($self) if $DEBUG > 1;
31              
32             $self->remap_fields(
33             card_number => 'cardnumber',
34             amount => 'Sum',
35             login => 'Username',
36             password => 'userpassword',
37             cvv2 => 'cvv',
38             );
39              
40             my $action = $self->{_content}{'action'};
41             if ( $action =~ /^\s*credit\s*$/i ) {
42             $self->{_content}{dealtype} = 51;
43             $self->{_content}{credittype} = 1;
44             } elsif ( $action !~ /^\s*normal\s*authorization\s*$/i ) {
45             die "invalid action";
46             }
47              
48             $self->{_content}{'expiration'} =~ /^(\d+)\D+\d*(\d{2})$/
49             or croak "unparsable expiration ". $self->{_content}{expiration};
50             my( $month, $year ) = ( $1, $2 );
51             $month = '0'. $month if $month =~ /^\d$/;
52             $self->{_content}{cardvalidityyear} = $year;
53             $self->{_content}{cardvaliditymonth} = $month;
54              
55             $self->{_content}{amount} = sprintf('%.2f', $self->{_content}{amount} );
56             $self->{_content}{languages} = 'en';
57            
58             $self->terminalnumber =~ /^\d+$/ or die "invalid TerminalNumber";
59             $self->{_content}{TerminalNumber} = $self->terminalnumber;
60            
61             $self->required_fields(
62             qw( login password TerminalNumber card_number amount )
63             );
64            
65             if($self->test_transaction) {
66             $self->{_content}{'Username'} = 'gali';
67             $self->{_content}{'userpassword'} = '7654321';
68             $self->{_content}{'TerminalNumber'} = '1000';
69             }
70            
71             tie my %fields, 'Tie::IxHash', $self->get_fields( $self->fields );
72             my $post_data = join('&', map "$_=$fields{$_}", keys %fields );
73             warn "POSTING: ".$post_data if $DEBUG > 1;
74              
75             my( $page, $response, @reply_headers) = $self->https_post( $post_data );
76              
77             if ($response !~ /^200/) {
78             # Connection error
79             $response =~ s/[\r\n]+/ /g; # ensure single line
80             $self->is_success(0);
81             my $diag_message = $response || "connection error";
82             die $diag_message;
83             }
84            
85             $self->server_response($page);
86              
87             unless ( $page =~ /^(\d+);(\d+);(.*?)$/ ) {
88             die "unparsable response received from gateway" .
89             ( $DEBUG ? ": $page" : '' );
90             }
91              
92             my $result = $1;
93             my $authorization = $2;
94             my $message = $3;
95              
96             $self->result_code($result);
97             if ( $result == 0 ) {
98             $self->is_success(1);
99             $self->authorization($authorization);
100             } else {
101             $self->is_success(0);
102             $self->error_message($message);
103             }
104             }
105              
106             sub fields {
107             my $self = shift;
108              
109             qw(
110             TerminalNumber
111             Sum
112             cardnumber
113             cardvalidityyear
114             cardvaliditymonth
115             Username
116             userpassword
117             languages
118             dealtype
119             credittype
120             cvv
121             );
122             }
123              
124             sub _info {
125             {
126             'info_compat' => '0.01',
127             'gateway_name' => 'Cardcom',
128             'gateway_url' => 'http://www.cardcom.co.il',
129             'module_version' => $VERSION,
130             'supported_types' => [ 'CC' ],
131             'token_support' => 0, # well technically the gateway supports it, but we haven't implemented it
132             'test_transaction' => 1,
133             'supported_actions' => [
134             'Normal Authorization',
135             'Credit',
136             ],
137             };
138             }
139              
140             1;
141              
142             __END__