lib/Business/OnlinePayment/PaymenTech.pm

   1 package Business::OnlinePayment::PaymenTech;
   2
   3 use strict;
   4 use Carp;
   5 use Business::OnlinePayment::HTTPS;
   6 use XML::Simple;
   7 use Tie::IxHash;
   8 use vars qw($VERSION $DEBUG @ISA $me);
   9
  10 @ISA = qw(Business::OnlinePayment::HTTPS);
  11
  12 $VERSION = '2.07';
  13 $VERSION = eval $VERSION; # modperlstyle: convert the string into a number
  14
  15 $DEBUG = 0;
  16 $me='Business::OnlinePayment::PaymenTech';
  17
  18 my %request_header = (
  19   'MIME-VERSION'    =>    '1.0',
  20   'Content-Transfer-Encoding' => 'text',
  21   'Request-Number'  =>    1,
  22   'Document-Type'   =>    'Request',
  23   'Interface-Version' =>  "$me $VERSION",
  24 ); # Content-Type has to be passed separately
  25
  26 tie my %new_order, 'Tie::IxHash', (
  27   OrbitalConnectionUsername => [ ':login', 32 ],
  28   OrbitalConnectionPassword => [ ':password', 32 ],
  29   IndustryType              => [ 'EC', 2 ],
  30   MessageType               => [ ':message_type', 2 ],
  31   BIN                       => [ ':bin', 6 ],
  32   MerchantID                => [ ':merchant_id', 12 ],
  33   TerminalID                => [ ':terminal_id', 3 ],
  34   CardBrand                 => [ '', 2 ],
  35   AccountNum                => [ ':card_number', 19 ],
  36   Exp                       => [ ':expiration', 4 ],
  37   CurrencyCode              => [ ':currency_code', 3 ],
  38   CurrencyExponent          => [ ':currency_exp', 6 ],
  39   CardSecValInd             => [ ':cvvind', 1 ],
  40   CardSecVal                => [ ':cvv2', 4 ],
  41   AVSzip                    => [ ':zip', 10 ],
  42   AVSaddress1               => [ ':address', 30 ],
  43   AVScity                   => [ ':city', 20 ],
  44   AVSstate                  => [ ':state', 2 ],
  45   AVScountryCode            => [ ':country', 2 ],
  46   OrderID                   => [ ':invoice_number', 22 ],
  47   Amount                    => [ ':amount', 12 ],
  48   Comments                  => [ ':email', 64 ],
  49   TxRefNum                  => [ ':order_number', 40 ],# used only for Refund
  50 );
  51
  52 tie my %mark_for_capture, 'Tie::IxHash', (
  53   OrbitalConnectionUsername => [ ':login', 32 ],
  54   OrbitalConnectionPassword => [ ':password', 32 ],
  55   OrderID                   => [ ':invoice_number', 22 ],
  56   Amount                    => [ ':amount', 12 ],
  57   BIN                       => [ ':bin', 6 ],
  58   MerchantID                => [ ':merchant_id', 12 ],
  59   TerminalID                => [ ':terminal_id', 3 ],
  60   TxRefNum                  => [ ':order_number', 40 ],
  61 );
  62
  63 tie my %reversal, 'Tie::IxHash', (
  64   OrbitalConnectionUsername => [ ':login', 32 ],
  65   OrbitalConnectionPassword => [ ':password', 32 ],
  66   TxRefNum                  => [ ':order_number', 40 ],
  67   TxRefIdx                  => [ '0', 4 ],
  68   OrderID                   => [ ':invoice_number', 22 ],
  69   BIN                       => [ ':bin', 6 ],
  70   MerchantID                => [ ':merchant_id', 12 ],
  71   TerminalID                => [ ':terminal_id', 3 ],
  72   OnlineReversalInd         => [ 'Y', 1 ],
  73 # Always attempt to reverse authorization.
  74 );
  75
  76 my %defaults = (
  77   terminal_id => '001',
  78   currency    => 'USD',
  79   cvvind      => '',
  80 );
  81
  82 my @required = ( qw(
  83   login
  84   password
  85   action
  86   bin
  87   merchant_id
  88   invoice_number
  89   amount
  90   )
  91 );
  92
  93 my %currency_code = (
  94 # Per ISO 4217.  Add to this as needed.
  95   USD => [840, 2],
  96   CAD => [124, 2],
  97   MXN => [484, 2],
  98 );
  99
 100 my %paymentech_countries = map { $_ => 1 } qw( US CA GB UK );
 101 my %failure_status = (
 102   # values of the RespCode element
 103   # in theory RespMsg should be set to a descriptive message, but it looks
 104   # like that's not reliable
 105   # XXX we should have a way to indicate other actions required by the
 106   # processor, such as "honor with identification", "call for instructions",
 107   # etc.
 108   '00'  => undef,         # Approved
 109   '04'  => 'pickup',      # Pickup
 110   '33'  => 'expired',     # Card is Expired
 111   '41'  => 'stolen',      # Lost/Stolen
 112   '42'  => 'inactive',    # Account Not Active
 113   '43'  => 'stolen',      # Lost/Stolen Card
 114   '44'  => 'inactive',    # Account Not Active
 115   #'45' duplicate transaction, should also have its own status
 116   'B7'  => 'blacklisted', # Fraud
 117   'B9'  => 'blacklisted', # On Negative File
 118   'BB'  => 'stolen',      # Possible Compromise
 119   'BG'  => 'blacklisted', # Blocked Account
 120   'BQ'  => 'blacklisted', # Issuer has Flagged Account as Suspected Fraud
 121   'C4'  => 'nsf',         # Over Credit Limit
 122   'D5'  => 'blacklisted', # On Negative File
 123   'D7'  => 'nsf',         # Insufficient Funds
 124   'F3'  => 'inactive',    # Account Closed
 125   'K6'  => 'nsf',         # NSF
 126 );
 127
 128 sub set_defaults {
 129     my $self = shift;
 130
 131     $self->server('orbitalvar1.chasepaymentech.com') unless $self->server; # this is the test server.
 132     $self->port('443') unless $self->port;
 133     $self->path('/authorize') unless $self->path;
 134
 135     $self->build_subs(qw(
 136       order_number
 137     ));
 138
 139     #leaking gateway-specific anmes?  need to be mapped to B:OP standards :)
 140     # ProcStatus
 141     # ApprovalStatus
 142     # StatusMsg
 143     # RespCode
 144     # AuthCode
 145     # AVSRespCode
 146     # CVV2RespCode
 147     # Response
 148 }
 149
 150 sub build {
 151   my $self = shift;
 152   my %content = $self->content();
 153   my $skel = shift;
 154   tie my %data, 'Tie::IxHash';
 155   ref($skel) eq 'HASH' or die 'Tried to build non-hash';
 156   foreach my $k (keys(%$skel)) {
 157     my $v = $skel->{$k};
 158     my $l;
 159     ($v, $l) = @$v if(ref $v eq 'ARRAY');
 160     if($v =~ /^:(.*)/) {
 161       # Get the content field with that name.
 162       $data{$k} = $content{$1};
 163     }
 164     else {
 165       $data{$k} = $v;
 166     }
 167     # Ruthlessly enforce field length.
 168     $data{$k} = substr($data{$k}, 0, $l) if($data{$k} and $l);
 169   }
 170   return \%data;
 171 }
 172
 173 sub map_fields {
 174     my($self) = @_;
 175
 176     my %content = $self->content();
 177     foreach(qw(merchant_id terminal_id currency)) {
 178       $content{$_} = $self->{$_} if exists($self->{$_});
 179     }
 180
 181     $self->required_fields('action');
 182     my %message_type =
 183                   ('normal authorization' => 'AC',
 184                    'authorization only'   => 'A',
 185                    'credit'               => 'R',
 186                    'void'                 => 'V',
 187                    'post authorization'   => 'MFC', # for our use, doesn't go in the request
 188                    );
 189     $content{'message_type'} = $message_type{lc($content{'action'})}
 190       or die "unsupported action: '".$content{'action'}."'";
 191
 192     foreach (keys(%defaults) ) {
 193       $content{$_} = $defaults{$_} if !defined($content{$_});
 194     }
 195     if(length($content{merchant_id}) == 12) {
 196       $content{bin} = '000002' # PNS
 197     }
 198     elsif(length($content{merchant_id}) == 6) {
 199       $content{bin} = '000001' # Salem
 200     }
 201     else {
 202       die "invalid merchant ID: '".$content{merchant_id}."'";
 203     }
 204
 205     @content{qw(currency_code currency_exp)} = @{$currency_code{$content{currency}}}
 206       if $content{currency};
 207
 208     if($content{card_number} =~ /^(4|6011)/) { # Matches Visa and Discover transactions
 209       if(defined($content{cvv2})) {
 210         $content{cvvind} = 1; # "Value is present"
 211       }
 212       else {
 213         $content{cvvind} = 9; # "Value is not available"
 214       }
 215     }
 216     $content{amount} = int($content{amount}*100);
 217     $content{name} = $content{first_name} . ' ' . $content{last_name};
 218 # According to the spec, the first 8 characters of this have to be unique.
 219 # The test server doesn't enforce this, but we comply anyway to the extent possible.
 220     if(! $content{invoice_number}) {
 221       # Choose one arbitrarily
 222       $content{invoice_number} ||= sprintf("%04x%04x",time % 2**16,int(rand() * 2**16));
 223     }
 224
 225     # Always send as MMYY
 226     $content{expiration} =~ s/\D//g;
 227     $content{expiration} = sprintf('%04d',$content{expiration});
 228
 229     $content{country} ||= 'US';
 230     $content{country} = ( $paymentech_countries{ $content{country} }
 231                             ? $content{country}
 232                             : ''
 233                         ),
 234
 235     $self->content(%content);
 236     return;
 237 }
 238
 239 sub submit {
 240   my($self) = @_;
 241   $DB::single = $DEBUG;
 242
 243   $self->map_fields();
 244   my %content = $self->content;
 245
 246   my @required_fields = @required;
 247
 248   my $request;
 249   if( $content{'message_type'} eq 'MFC' ) {
 250     $request = { MarkForCapture => $self->build(\%mark_for_capture) };
 251     push @required_fields, 'order_number';
 252   }
 253   elsif( $content{'message_type'} eq 'V' ) {
 254     $request = { Reversal => $self->build(\%reversal) };
 255   }
 256   else {
 257     $request = { NewOrder => $self->build(\%new_order) };
 258     push @required_fields, qw(
 259       card_number
 260       expiration
 261       currency
 262       address
 263       city
 264       zip
 265       );
 266   }
 267
 268   $self->required_fields(@required_fields);
 269
 270   my $post_data = XMLout({ Request => $request }, KeepRoot => 1, NoAttr => 1, NoSort => 1);
 271
 272   if (!$self->test_transaction()) {
 273     $self->server('orbital1.chasepaymentech.com');
 274   }
 275
 276   warn $post_data if $DEBUG;
 277   $DB::single = $DEBUG;
 278   my($page,$server_response,%headers) =
 279     $self->https_post( { 'Content-Type' => 'application/PTI47',
 280                          'headers' => \%request_header } ,
 281                           $post_data);
 282
 283   warn $page if $DEBUG;
 284
 285   my $response = XMLin($page, KeepRoot => 0);
 286   #$self->Response($response);
 287
 288   #use Data::Dumper;
 289   #warn Dumper($response) if $DEBUG;
 290
 291   my ($r) = values(%$response);
 292   #foreach(qw(ProcStatus RespCode AuthCode AVSRespCode CVV2RespCode)) {
 293   #  if(exists($r->{$_}) and
 294   #     !ref($r->{$_})) {
 295   #    $self->$_($r->{$_});
 296   #  }
 297   #}
 298
 299   foreach (keys %$r) {
 300
 301     #turn empty hashrefs into the empty string
 302     $r->{$_} = '' if ref($r->{$_}) && ! keys %{ $r->{$_} };
 303
 304     #turn hashrefs with content into scalars
 305     $r->{$_} = $r->{$_}{'content'}
 306       if ref($r->{$_}) && exists($r->{$_}{'content'});
 307   }
 308
 309   if ($server_response !~ /^200/) {
 310
 311     #$self->is_success(0);
 312     my $error = "Server error: '$server_response'";
 313     $error .= " / Transaction error: '".
 314               ($r->{'ProcStatusMsg'} || $r->{'StatusMsg'}) . "'"
 315       if $r->{'ProcStatus'} != 0;
 316     #$self->error_message($error);
 317     #overzealous?  are there "normal decline" transaction errors being returned?
 318     die "$error\n";
 319
 320   } else {
 321
 322     die "Unable to parse response_page\n" if !exists($r->{'ProcStatus'});
 323
 324     if ( $r->{'ProcStatus'} != 0 or
 325               # NewOrders get ApprovalStatus, Reversals don't.
 326               ( exists($r->{'ApprovalStatus'}) ?
 327                 $r->{'ApprovalStatus'} != 1 :
 328                 $r->{'StatusMsg'} ne 'Approved' )
 329             )
 330     {
 331
 332       $self->failure_status( $failure_status{ $r->{RespCode} } || 'decline' );
 333       $self->is_success(0);
 334       $self->error_message( "Transaction error: '".
 335                             ($r->{'ProcStatusMsg'} || $r->{'StatusMsg'}) . "'"
 336                           );
 337
 338     } else { # success!
 339
 340       $self->is_success(1);
 341       # For credits, AuthCode is empty and gets converted to a hashref.
 342       $self->authorization($r->{'AuthCode'}) if !ref($r->{'AuthCode'});
 343       $self->order_number($r->{'TxRefNum'});
 344     }
 345
 346   }
 347
 348 }
 349
 350 1;
 351 __END__
 352
 353 =head1 NAME
 354
 355 Business::OnlinePayment::PaymenTech - Chase Paymentech backend for Business::OnlinePayment
 356
 357 =head1 SYNOPSIS
 358
 359   $trans = new Business::OnlinePayment('PaymenTech',
 360     merchant_id     => "000111222333",
 361     terminal_id     => "001",
 362     currency        => "USD", # CAD, MXN
 363   );
 364
 365   $trans->content(
 366     login           => "login",
 367     password        => "password",
 368     type            => "CC",
 369     card_number     => "5500000000000004",
 370     expiration      => "0211",
 371     address         => "123 Anystreet",
 372     city            => "Sacramento",
 373     zip             => "95824",
 374     action          => "Normal Authorization",
 375     amount          => "24.99",
 376   );
 377
 378   $trans->submit;
 379   if($trans->is_approved) {
 380     print "Approved: ".$trans->authorization;
 381   } else {
 382     print "Failed: ".$trans->error_message;
 383   }
 384
 385 =head1 NOTES
 386
 387 Electronic check processing and recurring billing are not yet supported.
 388
 389 =head1 AUTHOR
 390
 391 Mark Wells, mark@freeside.biz
 392
 393 =head1 SEE ALSO
 394
 395 perl(1). L<Business::OnlinePayment>.
 396
 397 =cut
 398