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