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