LinkPoint.pm

   1 package Business::OnlinePayment::LinkPoint;
   2
   3 use strict;
   4 use vars qw($VERSION @ISA $DEBUG @EXPORT @EXPORT_OK);
   5 use Carp qw(croak);
   6 use Business::OnlinePayment;
   7
   8 @ISA = qw(Business::OnlinePayment);
   9 $VERSION = '0.09_01';
  10 $VERSION = eval $VERSION; # modperlstyle: convert the string into a number
  11 $DEBUG = 0;
  12
  13 use lpperl; #3;  #lpperl.pm from LinkPoint
  14 $LPPERL::VERSION =~ /^(\d+\.\d+)/
  15   or die "can't parse lpperl.pm version: $LPPERL::VERSION";
  16 die "lpperl.pm minimum version 3 required\n" unless $1 >= 3;
  17
  18 sub set_defaults {
  19     my $self = shift;
  20
  21     #$self->server('staging.linkpt.net');
  22     $self->server('secure.linkpt.net');
  23     $self->port('1129');
  24
  25     $self->build_subs(qw(order_number avs_code));
  26
  27 }
  28
  29 sub map_fields {
  30     my($self) = @_;
  31
  32     my %content = $self->content();
  33
  34     #ACTION MAP
  35     my %actions = ('normal authorization' => 'SALE',
  36                    'authorization only'   => 'PREAUTH',
  37                    'credit'               => 'CREDIT',
  38                    'post authorization'   => 'POSTAUTH',
  39                    'void'                 => 'VOID',
  40                   );
  41     $content{'action'} = $actions{lc($content{'action'})} || $content{'action'};
  42
  43     #ACCOUNT TYPE MAP
  44     my %account_types = ('personal checking' => 'pc',
  45                          'personal savings'  => 'ps',
  46                          'business checking' => 'bc',
  47                          'business savings'  => 'bs',
  48                         );
  49     $content{'account_type'} = $account_types{lc($content{'account_type'})}
  50                                || $content{'account_type'};
  51
  52     # stuff it back into %content
  53     $self->content(%content);
  54 }
  55
  56 sub build_subs {
  57     my $self = shift;
  58     foreach(@_) {
  59         #no warnings; #not 5.005
  60         local($^W)=0;
  61         eval "sub $_ { my \$self = shift; if(\@_) { \$self->{$_} = shift; } return \$self->{$_}; }";
  62     }
  63 }
  64
  65 sub remap_fields {
  66     my($self,%map) = @_;
  67
  68     my %content = $self->content();
  69     foreach(keys %map) {
  70         $content{$map{$_}} = $content{$_};
  71     }
  72     $self->content(%content);
  73 }
  74
  75 sub revmap_fields {
  76     my($self, %map) = @_;
  77     my %content = $self->content();
  78     foreach(keys %map) {
  79 #    warn "$_ = ". ( ref($map{$_})
  80 #                         ? ${ $map{$_} }
  81 #                         : $content{$map{$_}} ). "\n";
  82         $content{$_} = ref($map{$_})
  83                          ? ${ $map{$_} }
  84                          : $content{$map{$_}};
  85     }
  86     $self->content(%content);
  87 }
  88
  89 sub get_fields {
  90     my($self,@fields) = @_;
  91
  92     my %content = $self->content();
  93     my %new = ();
  94     foreach( grep defined $content{$_}, @fields) { $new{$_} = $content{$_}; }
  95     return %new;
  96 }
  97
  98 sub submit {
  99     my($self) = @_;
 100
 101     $self->map_fields();
 102
 103     my %content = $self->content;
 104
 105     my($month, $year);
 106     unless ( $content{action} eq 'POSTAUTH'
 107              || ( $content{'action'} =~ /^(CREDIT|VOID)$/
 108                   && exists $content{'order_number'} )
 109              || $self->transaction_type() =~ /^e?check$/i
 110            ) {
 111
 112         if (  $self->transaction_type() =~
 113                 /^(cc|visa|mastercard|american express|discover)$/i
 114            ) {
 115         } else {
 116             Carp::croak("LinkPoint can't handle transaction type: ".
 117                         $self->transaction_type());
 118         }
 119
 120       $content{'expiration'} =~ /^(\d+)\D+\d*(\d{2})$/
 121         or croak "unparsable expiration $content{expiration}";
 122
 123       ( $month, $year ) = ( $1, $2 );
 124       $month = '0'. $month if $month =~ /^\d$/;
 125     }
 126
 127     $content{'address'} =~ /^(\d+)\s/;
 128     my $addrnum = $1;
 129
 130     my $result = $content{'result'};
 131     if ( $self->test_transaction) {
 132       $result ||= 'GOOD';
 133       #$self->server('staging.linkpt.net');
 134     } else {
 135       $result ||= 'LIVE';
 136     }
 137
 138     #docs disagree with lpperl.pm here
 139     $content{'voidcheck'} = 1
 140       if ($self->transaction_type() =~ /^e?check$/i
 141           &&  $content{'action'} =~ /^VOID$/);
 142
 143     #strip phone numbers of non-digits for ACH/echeck
 144     #as per undocumented suggestion from LinkPoint
 145     if ( $self->transaction_type =~ /^e?check$/i ) {
 146       foreach my $field (qw( phone fax )) {
 147         $content{$field} =~ s/\D//g;
 148       }
 149     }
 150
 151     $self->revmap_fields(
 152       host         => \( $self->server ),
 153       port         => \( $self->port ),
 154       #storename    => \( $self->storename ),
 155       configfile   => \( $self->storename ),
 156       keyfile      => \( $self->keyfile ),
 157
 158       chargetotal  => 'amount',
 159       result       => \$result,
 160       addrnum      => \$addrnum,
 161       oid          => 'order_number',
 162       ip           => 'customer_ip',
 163       userid       => 'customer_id',
 164       ponumber     => 'invoice_number',
 165       comments     => 'description',
 166       #reference_number => 'reference_number',
 167
 168       cardnumber   => 'card_number',
 169       cardexpmonth => \$month,
 170       cardexpyear  => \$year,
 171
 172       bankname     => 'bank_name',
 173       bankstate    => 'bank_state',
 174       routing      => 'routing_code',
 175       account      => 'account_number',
 176       accounttype  => 'account_type',
 177       name         => 'account_name',
 178       dl           => 'state_id',
 179       dlstate      => 'state_id_state',
 180     );
 181
 182     my $lperl = new LPPERL;
 183
 184     my @required_fields = qw(host port configfile keyfile amount);
 185     if ($self->transaction_type() =~ /^(cc|visa|mastercard|american express|discover)$/i) {
 186       push @required_fields, qw(cardnumber cardexpmonth cardexpyear);
 187     }elsif ($self->transaction_type() =~ /^e?check$/i) {
 188       push @required_fields, qw(
 189         dl dlstate routing account accounttype bankname bankstate name
 190                                );
 191     }
 192     $self->required_fields(@required_fields);
 193
 194     my %post_data = $self->get_fields(qw/
 195       host port configfile keyfile
 196       result
 197       chargetotal cardnumber cardexpmonth cardexpyear
 198       name company email phone fax addrnum city state zip country
 199       oid
 200       dl dlstate routing account accounttype bankname bankstate name void
 201
 202     /);
 203
 204     $post_data{'ordertype'} = $content{action};
 205
 206     if ( $content{'cvv2'} ) {
 207       $post_data{cvmindicator} = 'provided';
 208       $post_data{cvmvalue} = $content{'cvv2'};
 209     }
 210
 211     if ( $DEBUG ) {
 212       warn "$_ => $post_data{$_}\n" foreach keys %post_data;
 213       $post_data{debug} = 'true';
 214     }
 215
 216     $post_data{'cargs'} = '-k -m 300 -s -S' if $self->test_transaction;
 217
 218     # avoid some uninitialized warnings in lpperl.pm
 219     foreach (qw(webspace debug debugging)) { $post_data{$_} ||= '' }
 220
 221     #my %response;
 222     #{
 223     #  local($^W)=0;
 224     #  %response = $lperl->$action(\%post_data);
 225     #}
 226     my %response = $lperl->curl_process(\%post_data);
 227
 228     if ( $DEBUG ) {
 229       warn "$_ => $response{$_}\n" for keys %response;
 230     }
 231
 232     if ( $response{'r_approved'} eq 'APPROVED' ) {
 233       $self->is_success(1);
 234       $self->result_code($response{'r_code'});
 235       $self->authorization($response{'r_ref'});
 236       $self->order_number($response{'r_ordernum'});
 237       $self->avs_code($response{'r_avs'});
 238     } else {
 239       $self->is_success(0);
 240       $self->result_code('');
 241       if ( $response{'r_error'} =~ /\S/ ) {
 242         $self->error_message($response{'r_error'});
 243       } else {
 244         $self->error_message($response{'r_approved'}); # no r_error for checks
 245       }
 246     }
 247
 248 }
 249
 250 1;
 251 __END__
 252
 253 =head1 NAME
 254
 255 Business::OnlinePayment::LinkPoint - LinkPoint (Cardservice) backend for Business::OnlinePayment
 256
 257 =head1 SYNOPSIS
 258
 259   use Business::OnlinePayment;
 260
 261   my $tx = new Business::OnlinePayment( 'LinkPoint',
 262     'storename' => 'your_store_number',
 263     'keyfile'   => '/path/to/keyfile.pem',
 264   );
 265
 266   $tx->content(
 267       type           => 'VISA',
 268       action         => 'Normal Authorization',
 269       description    => 'Business::OnlinePayment test',
 270       amount         => '49.95',
 271       invoice_number => '100100',
 272       customer_id    => 'jsk',
 273       name           => 'Jason Kohles',
 274       address        => '123 Anystreet',
 275       city           => 'Anywhere',
 276       state          => 'UT',
 277       zip            => '84058',
 278       email          => 'ivan-linkpoint@420.am',
 279       card_number    => '4007000000027',
 280       expiration     => '09/99',
 281   );
 282   $tx->submit();
 283
 284   if($tx->is_success()) {
 285       print "Card processed successfully: ".$tx->authorization."\n";
 286   } else {
 287       print "Card was rejected: ".$tx->error_message."\n";
 288   }
 289
 290 =head1 SUPPORTED TRANSACTION TYPES
 291
 292 =head2 Visa, MasterCard, American Express, JCB, Discover/Novus, Carte blanche/Diners Club
 293
 294 =head1 DESCRIPTION
 295
 296 For detailed information see L<Business::OnlinePayment>.
 297
 298 =head1 COMPATIBILITY
 299
 300 This module implements an interface to the LinkPoint Perl Wrapper "lpperl",
 301 which you need to download and install separately.
 302 http://www.linkpoint.com/product_solutions/internet/lperl/lperl_main.html
 303 http://www.linkpoint.com/viewcart/down_index.htm
 304
 305 Versions 0.4 and on of this module support the LinkPoint Perl Wrapper version
 306 3.5.
 307
 308 =head1 BUGS
 309
 310 =head1 AUTHOR
 311
 312 Ivan Kohler <ivan-linkpoint@420.am>
 313
 314 Contributions from Mark D. Anderson <mda@discerning.com>
 315
 316 Echeck work by Jeff Finucane <jeff@cmh.net>
 317
 318 Based on Busienss::OnlinePayment::AuthorizeNet written by Jason Kohles.
 319
 320 =head1 SEE ALSO
 321
 322 perl(1), L<Business::OnlinePayment>.
 323
 324 =cut
 325