File Coverage

blib/lib/Business/OnlinePayment/StGeorge.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Business::OnlinePayment::StGeorge;
2              
3 1     1   1222 use strict;
  1         2  
  1         36  
4 1     1   5 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
  1         1  
  1         83  
5 1     1   6 use Carp qw(croak);
  1         1  
  1         67  
6 1     1   937 use Business::OnlinePayment;
  1         3314  
  1         35  
7              
8             @ISA = qw(Business::OnlinePayment);
9             $VERSION = '0.02';
10              
11 1     1   1533 use webpayperl; #webpayperl.pm from St.George
  0            
  0            
12             webpayperl::init_client or croak "St.George initialization failed\n";
13              
14             sub set_defaults {
15             my $self = shift;
16              
17             $self->server('www.gwipg.stgeorge.com.au');
18             $self->port('3006');
19              
20             $self->build_subs(qw(order_number));
21              
22             }
23              
24             sub map_fields {
25             my($self) = @_;
26              
27             my %content = $self->content();
28              
29             #ACTION MAP
30             my %actions = ('normal authorization' => 'PURCHASE',
31             'authorization only' => 'PREAUTH',
32             'credit' => 'REFUND',
33             'post authorization' => 'COMPLETION',
34             );
35             $content{'action'} = $actions{lc($content{'action'})} || $content{'action'};
36              
37             # TYPE MAP
38             my %types = ('cc' => 'CREDITCARD',
39             'visa' => 'CREDITCARD',
40             'mastercard' => 'CREDITCARD',
41             'american express' => 'CREDITCARD',
42             'discover' => 'CREDITCARD',
43             );
44             $content{'type'} = $types{lc($content{'type'})} || $content{'type'};
45             $self->transaction_type($content{'type'});
46              
47             # stuff it back into %content
48             $self->content(%content);
49             }
50              
51             sub build_subs {
52             my $self = shift;
53             foreach(@_) {
54             #no warnings; #not 5.005
55             local($^W)=0;
56             eval "sub $_ { my \$self = shift; if(\@_) { \$self->{$_} = shift; } return \$self->{$_}; }";
57             }
58             }
59              
60             sub remap_fields {
61             my($self,%map) = @_;
62              
63             my %content = $self->content();
64             foreach(keys %map) {
65             $content{$map{$_}} = $content{$_};
66             }
67             $self->content(%content);
68             }
69              
70             sub revmap_fields {
71             my($self, %map) = @_;
72             my %content = $self->content();
73             foreach(keys %map) {
74             # warn "$_ = ". ( ref($map{$_})
75             # ? ${ $map{$_} }
76             # : $content{$map{$_}} ). "\n";
77             $content{$_} = ref($map{$_})
78             ? ${ $map{$_} }
79             : $content{$map{$_}};
80             }
81             $self->content(%content);
82             }
83              
84             sub get_fields {
85             my($self,@fields) = @_;
86              
87             my %content = $self->content();
88             my %new = ();
89             foreach( grep defined $content{$_}, @fields) { $new{$_} = $content{$_}; }
90             return %new;
91             }
92              
93             sub submit {
94             my($self) = @_;
95              
96             $self->map_fields();
97              
98             my %content = $self->content;
99              
100             my $exp = '';
101             unless ( $content{action} eq 'STATUS' ) {
102              
103             $content{'expiration'} =~ /^(\d+)\D+\d*(\d{2})$/
104             or croak "unparsable expiration $content{expiration}";
105              
106             my( $month, $year ) = ( $1, $2 );
107             $month = '0'. $month if $month =~ /^\d$/;
108             $exp = "$month$year";
109              
110             }
111              
112             if ( $self->test_transaction) {
113             $self->port(3007);
114             }
115              
116             my $terminal_type = 0;
117             $terminal_type = 4 if $content{'recurring_billing'};
118              
119             $self->revmap_fields(
120             INTERFACE => 'type',
121             TRANSACTIONTYPE => 'action',
122             TOTALAMOUNT => 'amount',
123             #TAXAMOUNT
124             CARDDATA => 'card_number',
125             CARDEXPIRYDATE => \$exp,
126             #TXNREFERENCE
127             #ORIGINALTXNREF
128             #AUTHORISATIONNUMBER
129             CLIENTREF => 'customer_id',
130             COMMENT => 'invoice_number',
131             TERMINALTYPE => \$terminal_type,
132             CVC2 => 'cvv2',
133             );
134              
135             my $action = $content{action};
136              
137             if ( $action eq 'PURCHASE' || $action eq 'PREAUTH' ) {
138             $self->required_fields(qw/
139             login password
140             INTERFACE TRANSACTIONTYPE TOTALAMOUNT CARDDATA CARDEXPIRYDATE
141             /);
142             } elsif ( $action eq 'REFUND' ) {
143             $self->required_fields(qw/
144             login password
145             INTERFACE TRANSACTIONTYPE TOTALAMOUNT CARDDATA CARDEXPIRYDATE
146             ORIGINALTXNREF
147             /);
148             } elsif ( $action eq 'COMPLETION' ) {
149             $self->required_fields(qw/
150             login password
151             INTERFACE TRANSACTIONTYPE TOTALAMOUNT CARDDATA CARDEXPIRYDATE
152             AUTHORISATIONNUMBER
153             /);
154             } elsif ( $action eq 'STATUS' ) {
155             $self->required_fields(qw/
156             login password
157             TXNREFERENCE
158             /);
159             }
160              
161             my %post = $self->get_fields(qw/
162             login password
163             INTERFACE TRANSACTIONTYPE TOTALAMOUNT CARDDATA CARDEXPIRYDATE
164             /);
165              
166             # if ( $DEBUG ) { warn "$_ => $post{$_}\n" foreach keys %post; }
167              
168             my $webpayRef = webpayperl::newBundle;
169             webpayperl::addVersionInfo($webpayRef);
170             webpayperl::put($webpayRef, "DEBUG", "OFF");
171             #webpayperl::put($webpayRef, "LOGFILE", "webpay.log");
172             webpayperl::put_ClientID ( $webpayRef, delete $post{'login'} );
173             webpayperl::put_CertificatePath ( $webpayRef, $self->cert_path );
174             webpayperl::put_CertificatePassword( $webpayRef, delete $post{'password'} );
175             webpayperl::setPort ( $webpayRef, $self->port );
176             webpayperl::setServers ( $webpayRef, $self->server );
177              
178             foreach my $key ( keys %post ) {
179             warn "$key undefined" unless defined($post{$key});
180             webpayperl::put($webpayRef, $key, $post{$key} );
181             }
182              
183             my $tranProcessed = webpayperl::execute( $webpayRef );
184             unless ( $tranProcessed ) {
185             #St.George error handling is bunk
186             $self->is_success(0);
187             $self->error_message( webpayperl::get( $webpayRef, "ERROR").
188             ' (transaction reference: '.
189             webpayperl::get( $webpayRef, 'TXNREFERENCE' ).
190             ')'
191             );
192              
193             webpayperl::cleanup( $webpayRef );
194             return;
195             }
196              
197             my $responseCode = webpayperl::get( $webpayRef, "RESPONSECODE");
198             $self->result_code($responseCode);
199              
200             if ( grep { $responseCode eq $_ } qw( 00 08 77 ) ) {
201             $self->is_success(1);
202             $self->authorization(webpayperl::get( $webpayRef, "AUTHCODE"));
203             $self->order_number(webpayperl::get( $webpayRef, "TXNREFERENCE"));
204             } else {
205             $self->is_success(0);
206             $self->error_message( webpayperl::get( $webpayRef, "RESPONSETEXT"). ' - '.
207             webpayperl::get( $webpayRef, "ERROR").
208             ' (transaction reference: '.
209             webpayperl::get( $webpayRef, 'TXNREFERENCE' ).
210             ')'
211             );
212             }
213            
214             webpayperl::cleanup( $webpayRef );
215              
216             }
217              
218             END {
219             webpayperl::free_client();
220             }
221              
222             1;
223             __END__