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 $VERSION = '2.03_02';
  12 $DEBUG = 0;
  13 $me='Business::OnlinePayment::PaymenTech';
  14
  15 my %request_header = (
  16   'MIME-VERSION'    =>    '1.0',
  17   'Content-Transfer-Encoding' => 'text',
  18   'Request-Number'  =>    1,
  19   'Document-Type'   =>    'Request',
  20   'Interface-Version' =>  "$me $VERSION",
  21 ); # Content-Type has to be passed separately
  22
  23 tie my %new_order, 'Tie::IxHash', (
  24   OrbitalConnectionUsername => ':login',
  25   OrbitalConnectionPassword => ':password',
  26   IndustryType              => 'EC', # Assume industry = Ecommerce
  27   MessageType               => ':message_type',
  28   BIN                       => ':bin',
  29   MerchantID                => ':merchant_id',
  30   TerminalID                => ':terminal_id',
  31   CardBrand                 => '',
  32   AccountNum                => ':card_number',
  33   Exp                       => ':expiration',
  34   CurrencyCode              => ':currency_code',
  35   CurrencyExponent          => ':currency_exp',
  36   CardSecValInd             => ':cvvind',
  37   CardSecVal                => ':cvv2',
  38   AVSzip                    => ':zip',
  39   AVSaddress1               => ':address',
  40   AVScity                   => ':city',
  41   AVSstate                  => ':state',
  42   OrderID                   => ':invoice_number',
  43   Amount                    => ':amount',
  44   Comments                  => ':email', # as per B:OP:WesternACH
  45   TxRefNum                  => ':order_number', # used only for Refund
  46 );
  47
  48 tie my %mark_for_capture, 'Tie::IxHash', (
  49   OrbitalConnectionUsername => ':login',
  50   OrbitalConnectionPassword => ':password',
  51   OrderID                   => ':invoice_number',
  52   Amount                    => ':amount',
  53   BIN                       => ':bin',
  54   MerchantID                => ':merchant_id',
  55   TerminalID                => ':terminal_id',
  56   TxRefNum                  => ':order_number',
  57 );
  58
  59 tie my %reversal, 'Tie::IxHash', (
  60   OrbitalConnectionUsername => ':login',
  61   OrbitalConnectionPassword => ':password',
  62   TxRefNum                  => ':order_number',
  63   TxRefIdx                  => 0,
  64   OrderID                   => ':invoice_number',
  65   BIN                       => ':bin',
  66   MerchantID                => ':merchant_id',
  67   TerminalID                => ':terminal_id',
  68 # Always attempt to reverse authorization.
  69   OnlineReversalInd         => 'Y',
  70 );
  71
  72 my %defaults = (
  73   terminal_id => '001',
  74   currency    => 'USD',
  75   cvvind      => '',
  76 );
  77
  78 my @required = ( qw(
  79   login
  80   password
  81   action
  82   bin
  83   merchant_id
  84   invoice_number
  85   amount
  86   )
  87 );
  88
  89 my %currency_code = (
  90 # Per ISO 4217.  Add to this as needed.
  91   USD => [840, 2],
  92   CAD => [124, 2],
  93   MXN => [484, 2],
  94 );
  95
  96 sub set_defaults {
  97     my $self = shift;
  98
  99     $self->server('orbitalvar1.paymentech.net') unless $self->server; # this is the test server.
 100     $self->port('443') unless $self->port;
 101     $self->path('/authorize') unless $self->path;
 102
 103     $self->build_subs(qw(
 104       order_number
 105     ));
 106
 107     #leaking gateway-specific anmes?  need to be mapped to B:OP standards :)
 108     # ProcStatus
 109     # ApprovalStatus
 110     # StatusMsg
 111     # RespCode
 112     # AuthCode
 113     # AVSRespCode
 114     # CVV2RespCode
 115     # Response
 116 }
 117
 118 sub build {
 119   my $self = shift;
 120   my %content = $self->content();
 121   my $skel = shift;
 122   tie my %data, 'Tie::IxHash';
 123   ref($skel) eq 'HASH' or die 'Tried to build non-hash';
 124   foreach my $k (keys(%$skel)) {
 125     my $v = $skel->{$k};
 126     # Not recursive like B:OP:WesternACH; Paymentech requests are only one layer deep.
 127     if($v =~ /^:(.*)/) {
 128       # Get the content field with that name.
 129       $data{$k} = $content{$1};
 130     }
 131     else {
 132       $data{$k} = $v;
 133     }
 134   }
 135   return \%data;
 136 }
 137
 138 sub map_fields {
 139     my($self) = @_;
 140
 141     my %content = $self->content();
 142     foreach(qw(merchant_id terminal_id currency)) {
 143       $content{$_} = $self->{$_} if exists($self->{$_});
 144     }
 145
 146     $self->required_fields('action');
 147     my %message_type =
 148                   ('normal authorization' => 'AC',
 149                    'authorization only'   => 'A',
 150                    'credit'               => 'R',
 151                    'void'                 => 'V',
 152                    'post authorization'   => 'MFC', # for our use, doesn't go in the request
 153                    );
 154     $content{'message_type'} = $message_type{lc($content{'action'})}
 155       or die "unsupported action: '".$content{'action'}."'";
 156
 157     foreach (keys(%defaults) ) {
 158       $content{$_} = $defaults{$_} if !defined($content{$_});
 159     }
 160     if(length($content{merchant_id}) == 12) {
 161       $content{bin} = '000002' # PNS
 162     }
 163     elsif(length($content{merchant_id}) == 6) {
 164       $content{bin} = '000001' # Salem
 165     }
 166     else {
 167       die "invalid merchant ID: '".$content{merchant_id}."'";
 168     }
 169
 170     @content{qw(currency_code currency_exp)} = @{$currency_code{$content{currency}}}
 171       if $content{currency};
 172
 173     if($content{card_number} =~ /^(4|6011)/) { # Matches Visa and Discover transactions
 174       if(defined($content{cvv2})) {
 175         $content{cvvind} = 1; # "Value is present"
 176       }
 177       else {
 178         $content{cvvind} = 9; # "Value is not available"
 179       }
 180     }
 181     $content{amount} = int($content{amount}*100);
 182     $content{name} = $content{first_name} . ' ' . $content{last_name};
 183 # According to the spec, the first 8 characters of this have to be unique.
 184 # The test server doesn't enforce this, but we comply anyway to the extent possible.
 185     if(! $content{invoice_number}) {
 186       # Choose one arbitrarily
 187       $content{invoice_number} ||= sprintf("%04x%04x",time % 2**16,int(rand() * 2**16));
 188     }
 189
 190     $content{expiration} =~ s/\D//g; # Because Freeside sends it as mm/yy, not mmyy.
 191
 192     $self->content(%content);
 193     return;
 194 }
 195
 196 sub submit {
 197   my($self) = @_;
 198   $DB::single = $DEBUG;
 199
 200   $self->map_fields();
 201   my %content = $self->content;
 202
 203   my @required_fields = @required;
 204
 205   my $request;
 206   if( $content{'message_type'} eq 'MFC' ) {
 207     $request = { MarkForCapture => $self->build(\%mark_for_capture) };
 208     push @required_fields, 'order_number';
 209   }
 210   elsif( $content{'message_type'} eq 'V' ) {
 211     $request = { Reversal => $self->build(\%reversal) };
 212   }
 213   else {
 214     $request = { NewOrder => $self->build(\%new_order) };
 215     push @required_fields, qw(
 216       card_number
 217       expiration
 218       currency
 219       address
 220       city
 221       zip
 222       );
 223   }
 224
 225   $self->required_fields(@required_fields);
 226
 227   my $post_data = XMLout({ Request => $request }, KeepRoot => 1, NoAttr => 1, NoSort => 1);
 228
 229   if (!$self->test_transaction()) {
 230     $self->server('orbital1.paymentech.net');
 231   }
 232
 233   warn $post_data if $DEBUG;
 234   $DB::single = $DEBUG;
 235   my($page,$server_response,%headers) =
 236     $self->https_post( { 'Content-Type' => 'application/PTI47',
 237                          'headers' => \%request_header } ,
 238                           $post_data);
 239
 240   warn $page if $DEBUG;
 241
 242   my $response = XMLin($page, KeepRoot => 0);
 243   #$self->Response($response);
 244
 245   #use Data::Dumper;
 246   #warn Dumper($response) if $DEBUG;
 247
 248   my ($r) = values(%$response);
 249   #foreach(qw(ProcStatus RespCode AuthCode AVSRespCode CVV2RespCode)) {
 250   #  if(exists($r->{$_}) and
 251   #     !ref($r->{$_})) {
 252   #    $self->$_($r->{$_});
 253   #  }
 254   #}
 255
 256   foreach (keys %$r) {
 257
 258     #turn empty hashrefs into the empty string
 259     $r->{$_} = '' if ref($r->{$_}) && ! keys %{ $r->{$_} };
 260
 261     #turn hashrefs with content into scalars
 262     $r->{$_} = $r->{$_}{'content'}
 263       if ref($r->{$_}) && exists($r->{$_}{'content'});
 264   }
 265
 266   if ($server_response !~ /^200/) {
 267
 268     $self->is_success(0);
 269     my $error = "Server error: '$server_response'";
 270     $error .= " / Transaction error: '".
 271               ($r->{'ProcStatusMsg'} || $r->{'StatusMsg'}) . "'"
 272       if $r->{'ProcStatus'} != 0;
 273     $self->error_message($error);
 274
 275   } else {
 276
 277     if ( !exists($r->{'ProcStatus'}) ) {
 278
 279       $self->is_success(0);
 280       $self->error_message( "Malformed response: '$page'" );
 281
 282     } elsif ( $r->{'ProcStatus'} != 0 or
 283               # NewOrders get ApprovalStatus, Reversals don't.
 284               ( exists($r->{'ApprovalStatus'}) ?
 285                 $r->{'ApprovalStatus'} != 1 :
 286                 $r->{'StatusMsg'} ne 'Approved' )
 287             )
 288     {
 289
 290       $self->is_success(0);
 291       $self->error_message( "Transaction error: '".
 292                             ($r->{'ProcStatusMsg'} || $r->{'StatusMsg'}) . "'"
 293                           );
 294
 295     } else { # success!
 296
 297       $self->is_success(1);
 298       # For credits, AuthCode is empty and gets converted to a hashref.
 299       $self->authorization($r->{'AuthCode'}) if !ref($r->{'AuthCode'});
 300       $self->order_number($r->{'TxRefNum'});
 301     }
 302
 303   }
 304
 305 }
 306
 307 1;
 308 __END__
 309
 310 =head1 NAME
 311
 312 Business::OnlinePayment::PaymenTech - Chase Paymentech backend for Business::OnlinePayment
 313
 314 =head1 SYNOPSIS
 315
 316   $trans = new Business::OnlinePayment('PaymenTech',
 317     merchant_id     => "000111222333",
 318     terminal_id     => "001",
 319     currency        => "USD", # CAD, MXN
 320   );
 321
 322   $trans->content(
 323     login           => "login",
 324     password        => "password",
 325     type            => "CC",
 326     card_number     => "5500000000000004",
 327     expiration      => "0211",
 328     address         => "123 Anystreet",
 329     city            => "Sacramento",
 330     zip             => "95824",
 331     action          => "Normal Authorization",
 332     amount          => "24.99",
 333   );
 334
 335   $trans->submit;
 336   if($trans->is_approved) {
 337     print "Approved: ".$trans->authorization;
 338   } else {
 339     print "Failed: ".$trans->error_message;
 340   }
 341
 342 =head1 NOTES
 343
 344 The only supported transaction types are Normal Authorization and Credit.
 345 Paymentech supports separate Authorize and Capture actions as well as recurring
 346 billing, but those are not yet implemented.
 347
 348 Electronic check processing is not yet supported.
 349
 350 =head1 AUTHOR
 351
 352 Mark Wells, mark@freeside.biz
 353
 354 =head1 SEE ALSO
 355
 356 perl(1). L<Business::OnlinePayment>.
 357
 358 =cut
 359