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.11';
  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     #strip phone numbers of non-digits for ACH/echeck
 139     #as per undocumented suggestion from LinkPoint
 140     if ( $self->transaction_type =~ /^e?check$/i ) {
 141       foreach my $field (qw( phone fax )) {
 142         $content{$field} =~ s/\D//g;
 143       }
 144     }
 145     # stuff it back into %content
 146     $self->content(%content);
 147
 148     $self->revmap_fields(
 149       host         => \( $self->server ),
 150       port         => \( $self->port ),
 151       #storename    => \( $self->storename ),
 152       configfile   => \( $self->storename ),
 153       keyfile      => \( $self->keyfile ),
 154
 155       chargetotal  => 'amount',
 156       result       => \$result,
 157       addrnum      => \$addrnum,
 158       oid          => 'order_number',
 159       ip           => 'customer_ip',
 160       userid       => 'customer_id',
 161       ponumber     => 'invoice_number',
 162       comments     => 'description',
 163       #reference_number => 'reference_number',
 164
 165       cardnumber   => 'card_number',
 166       cardexpmonth => \$month,
 167       cardexpyear  => \$year,
 168
 169       bankname     => 'bank_name',
 170       bankstate    => 'bank_state',
 171       routing      => 'routing_code',
 172       account      => 'account_number',
 173       accounttype  => 'account_type',
 174       name         => 'account_name',
 175       dl           => 'state_id',
 176       dlstate      => 'state_id_state',
 177     );
 178
 179     my $lperl = new LPPERL;
 180
 181     my @required_fields = qw(host port configfile keyfile amount);
 182     if ($self->transaction_type() =~ /^(cc|visa|mastercard|american express|discover)$/i) {
 183       push @required_fields, qw(cardnumber cardexpmonth cardexpyear);
 184     }elsif ($self->transaction_type() =~ /^e?check$/i) {
 185       push @required_fields, qw(
 186         dl dlstate routing account accounttype bankname bankstate name
 187                                );
 188     }
 189     $self->required_fields(@required_fields);
 190
 191     my %post_data = $self->get_fields(qw/
 192       host port configfile keyfile
 193       result
 194       chargetotal cardnumber cardexpmonth cardexpyear
 195       name company email phone fax addrnum city state zip country
 196       oid
 197       dl dlstate routing account accounttype bankname bankstate name void
 198
 199     /);
 200
 201     $post_data{'ordertype'} = $content{action};
 202
 203     #docs disagree with lpperl.pm here
 204     $post_data{'voidcheck'} = 1
 205       if $self->transaction_type() =~ /^e?check$/i
 206           && $post_data{'ordertype'} =~ /^VOID$/;
 207
 208     if ( $content{'cvv2'} ) {
 209       $post_data{cvmindicator} = 'provided';
 210       $post_data{cvmvalue} = $content{'cvv2'};
 211     }
 212
 213     if ( $DEBUG ) {
 214       warn "$_ => $post_data{$_}\n" foreach keys %post_data;
 215       $post_data{debug} = 'true';
 216     }
 217
 218     $post_data{'cargs'} = '-k -m 300 -s -S'; #if $self->test_transaction;
 219
 220     # avoid some uninitialized warnings in lpperl.pm
 221     foreach (qw(webspace debug debugging)) { $post_data{$_} ||= '' }
 222
 223     #my %response;
 224     #{
 225     #  local($^W)=0;
 226     #  %response = $lperl->$action(\%post_data);
 227     #}
 228     my %response = $lperl->curl_process(\%post_data);
 229
 230     if ( $DEBUG ) {
 231       warn "$_ => $response{$_}\n" for keys %response;
 232     }
 233
 234     if ( $response{'r_approved'} eq 'APPROVED'
 235          or ( $self->transaction_type() =~ /^e?check$/i
 236               && $response{'r_approved'} eq 'SUBMITTED'
 237             )
 238        )
 239     {
 240       $self->is_success(1);
 241       $self->result_code($response{'r_code'});
 242       $self->authorization($response{'r_ref'});
 243       $self->order_number($response{'r_ordernum'});
 244       $self->avs_code($response{'r_avs'});
 245     } else {
 246       $self->is_success(0);
 247       $self->result_code('');
 248       if ( $response{'r_error'} =~ /\S/ ) {
 249         $self->error_message($response{'r_error'});
 250       } else {
 251         $self->error_message($response{'r_approved'}); # no r_error for checks
 252       }
 253     }
 254
 255 }
 256
 257 1;
 258 __END__
 259
 260 =head1 NAME
 261
 262 Business::OnlinePayment::LinkPoint - LinkPoint (Cardservice) backend for Business::OnlinePayment
 263
 264 =head1 SYNOPSIS
 265
 266   use Business::OnlinePayment;
 267
 268   my $tx = new Business::OnlinePayment( 'LinkPoint',
 269     'storename' => 'your_store_number',
 270     'keyfile'   => '/path/to/keyfile.pem',
 271   );
 272
 273   $tx->content(
 274       type           => 'VISA',
 275       action         => 'Normal Authorization',
 276       description    => 'Business::OnlinePayment test',
 277       amount         => '49.95',
 278       invoice_number => '100100',
 279       customer_id    => 'jsk',
 280       name           => 'Jason Kohles',
 281       address        => '123 Anystreet',
 282       city           => 'Anywhere',
 283       state          => 'UT',
 284       zip            => '84058',
 285       email          => 'ivan-linkpoint@420.am',
 286       card_number    => '4007000000027',
 287       expiration     => '09/99',
 288   );
 289   $tx->submit();
 290
 291   if($tx->is_success()) {
 292       print "Card processed successfully: ".$tx->authorization."\n";
 293   } else {
 294       print "Card was rejected: ".$tx->error_message."\n";
 295   }
 296
 297 =head1 SUPPORTED TRANSACTION TYPES
 298
 299 =head2 Visa, MasterCard, American Express, JCB, Discover/Novus, Carte blanche/Diners Club
 300
 301 =head1 DESCRIPTION
 302
 303 For detailed information see L<Business::OnlinePayment>.
 304
 305 =head1 COMPATIBILITY
 306
 307 This module implements an interface to the LinkPoint Perl Wrapper "lpperl",
 308 which you need to download and install separately.
 309 http://www.linkpoint.com/product_solutions/internet/lperl/lperl_main.html
 310 http://www.linkpoint.com/viewcart/down_index.htm
 311
 312 Versions 0.4 and on of this module support the LinkPoint Perl Wrapper version
 313 3.5.
 314
 315 =head1 BUGS
 316
 317 =head1 AUTHOR
 318
 319 Ivan Kohler <ivan-linkpoint@420.am>
 320
 321 Contributions from Mark D. Anderson <mda@discerning.com>
 322
 323 Echeck work by Jeff Finucane <jeff@cmh.net>
 324
 325 Based on Busienss::OnlinePayment::AuthorizeNet written by Jason Kohles.
 326
 327 =head1 SEE ALSO
 328
 329 perl(1), L<Business::OnlinePayment>.
 330
 331 =cut
 332