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_02';
  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       $self->is_success(1);
 236       $self->result_code($response{'r_code'});
 237       $self->authorization($response{'r_ref'});
 238       $self->order_number($response{'r_ordernum'});
 239       $self->avs_code($response{'r_avs'});
 240     } else {
 241       $self->is_success(0);
 242       $self->result_code('');
 243       if ( $response{'r_error'} =~ /\S/ ) {
 244         $self->error_message($response{'r_error'});
 245       } else {
 246         $self->error_message($response{'r_approved'}); # no r_error for checks
 247       }
 248     }
 249
 250 }
 251
 252 1;
 253 __END__
 254
 255 =head1 NAME
 256
 257 Business::OnlinePayment::LinkPoint - LinkPoint (Cardservice) backend for Business::OnlinePayment
 258
 259 =head1 SYNOPSIS
 260
 261   use Business::OnlinePayment;
 262
 263   my $tx = new Business::OnlinePayment( 'LinkPoint',
 264     'storename' => 'your_store_number',
 265     'keyfile'   => '/path/to/keyfile.pem',
 266   );
 267
 268   $tx->content(
 269       type           => 'VISA',
 270       action         => 'Normal Authorization',
 271       description    => 'Business::OnlinePayment test',
 272       amount         => '49.95',
 273       invoice_number => '100100',
 274       customer_id    => 'jsk',
 275       name           => 'Jason Kohles',
 276       address        => '123 Anystreet',
 277       city           => 'Anywhere',
 278       state          => 'UT',
 279       zip            => '84058',
 280       email          => 'ivan-linkpoint@420.am',
 281       card_number    => '4007000000027',
 282       expiration     => '09/99',
 283   );
 284   $tx->submit();
 285
 286   if($tx->is_success()) {
 287       print "Card processed successfully: ".$tx->authorization."\n";
 288   } else {
 289       print "Card was rejected: ".$tx->error_message."\n";
 290   }
 291
 292 =head1 SUPPORTED TRANSACTION TYPES
 293
 294 =head2 Visa, MasterCard, American Express, JCB, Discover/Novus, Carte blanche/Diners Club
 295
 296 =head1 DESCRIPTION
 297
 298 For detailed information see L<Business::OnlinePayment>.
 299
 300 =head1 COMPATIBILITY
 301
 302 This module implements an interface to the LinkPoint Perl Wrapper "lpperl",
 303 which you need to download and install separately.
 304 http://www.linkpoint.com/product_solutions/internet/lperl/lperl_main.html
 305 http://www.linkpoint.com/viewcart/down_index.htm
 306
 307 Versions 0.4 and on of this module support the LinkPoint Perl Wrapper version
 308 3.5.
 309
 310 =head1 BUGS
 311
 312 =head1 AUTHOR
 313
 314 Ivan Kohler <ivan-linkpoint@420.am>
 315
 316 Contributions from Mark D. Anderson <mda@discerning.com>
 317
 318 Echeck work by Jeff Finucane <jeff@cmh.net>
 319
 320 Based on Busienss::OnlinePayment::AuthorizeNet written by Jason Kohles.
 321
 322 =head1 SEE ALSO
 323
 324 perl(1), L<Business::OnlinePayment>.
 325
 326 =cut
 327