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.06_01';
  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
 102 sub set_defaults {
 103     my $self = shift;
 104
 105     $self->server('orbitalvar1.paymentech.net') unless $self->server; # this is the test server.
 106     $self->port('443') unless $self->port;
 107     $self->path('/authorize') unless $self->path;
 108
 109     $self->build_subs(qw(
 110       order_number
 111     ));
 112
 113     #leaking gateway-specific anmes?  need to be mapped to B:OP standards :)
 114     # ProcStatus
 115     # ApprovalStatus
 116     # StatusMsg
 117     # RespCode
 118     # AuthCode
 119     # AVSRespCode
 120     # CVV2RespCode
 121     # Response
 122 }
 123
 124 sub build {
 125   my $self = shift;
 126   my %content = $self->content();
 127   my $skel = shift;
 128   tie my %data, 'Tie::IxHash';
 129   ref($skel) eq 'HASH' or die 'Tried to build non-hash';
 130   foreach my $k (keys(%$skel)) {
 131     my $v = $skel->{$k};
 132     my $l;
 133     ($v, $l) = @$v if(ref $v eq 'ARRAY');
 134     if($v =~ /^:(.*)/) {
 135       # Get the content field with that name.
 136       $data{$k} = $content{$1};
 137     }
 138     else {
 139       $data{$k} = $v;
 140     }
 141     # Ruthlessly enforce field length.
 142     $data{$k} = substr($data{$k}, 0, $l) if($data{$k} and $l);
 143   }
 144   return \%data;
 145 }
 146
 147 sub map_fields {
 148     my($self) = @_;
 149
 150     my %content = $self->content();
 151     foreach(qw(merchant_id terminal_id currency)) {
 152       $content{$_} = $self->{$_} if exists($self->{$_});
 153     }
 154
 155     $self->required_fields('action');
 156     my %message_type =
 157                   ('normal authorization' => 'AC',
 158                    'authorization only'   => 'A',
 159                    'credit'               => 'R',
 160                    'void'                 => 'V',
 161                    'post authorization'   => 'MFC', # for our use, doesn't go in the request
 162                    );
 163     $content{'message_type'} = $message_type{lc($content{'action'})}
 164       or die "unsupported action: '".$content{'action'}."'";
 165
 166     foreach (keys(%defaults) ) {
 167       $content{$_} = $defaults{$_} if !defined($content{$_});
 168     }
 169     if(length($content{merchant_id}) == 12) {
 170       $content{bin} = '000002' # PNS
 171     }
 172     elsif(length($content{merchant_id}) == 6) {
 173       $content{bin} = '000001' # Salem
 174     }
 175     else {
 176       die "invalid merchant ID: '".$content{merchant_id}."'";
 177     }
 178
 179     @content{qw(currency_code currency_exp)} = @{$currency_code{$content{currency}}}
 180       if $content{currency};
 181
 182     if($content{card_number} =~ /^(4|6011)/) { # Matches Visa and Discover transactions
 183       if(defined($content{cvv2})) {
 184         $content{cvvind} = 1; # "Value is present"
 185       }
 186       else {
 187         $content{cvvind} = 9; # "Value is not available"
 188       }
 189     }
 190     $content{amount} = int($content{amount}*100);
 191     $content{name} = $content{first_name} . ' ' . $content{last_name};
 192 # According to the spec, the first 8 characters of this have to be unique.
 193 # The test server doesn't enforce this, but we comply anyway to the extent possible.
 194     if(! $content{invoice_number}) {
 195       # Choose one arbitrarily
 196       $content{invoice_number} ||= sprintf("%04x%04x",time % 2**16,int(rand() * 2**16));
 197     }
 198
 199     # Always send as MMYY
 200     $content{expiration} =~ s/\D//g;
 201     $content{expiration} = sprintf('%04d',$content{expiration});
 202
 203     $content{country} ||= 'US';
 204     $content{country} = ( $paymentech_countries{ $content{country} }
 205                             ? $content{country}
 206                             : ''
 207                         ),
 208
 209     $self->content(%content);
 210     return;
 211 }
 212
 213 sub submit {
 214   my($self) = @_;
 215   $DB::single = $DEBUG;
 216
 217   $self->map_fields();
 218   my %content = $self->content;
 219
 220   my @required_fields = @required;
 221
 222   my $request;
 223   if( $content{'message_type'} eq 'MFC' ) {
 224     $request = { MarkForCapture => $self->build(\%mark_for_capture) };
 225     push @required_fields, 'order_number';
 226   }
 227   elsif( $content{'message_type'} eq 'V' ) {
 228     $request = { Reversal => $self->build(\%reversal) };
 229   }
 230   else {
 231     $request = { NewOrder => $self->build(\%new_order) };
 232     push @required_fields, qw(
 233       card_number
 234       expiration
 235       currency
 236       address
 237       city
 238       zip
 239       );
 240   }
 241
 242   $self->required_fields(@required_fields);
 243
 244   my $post_data = XMLout({ Request => $request }, KeepRoot => 1, NoAttr => 1, NoSort => 1);
 245
 246   if (!$self->test_transaction()) {
 247     $self->server('orbital1.paymentech.net');
 248   }
 249
 250   warn $post_data if $DEBUG;
 251   $DB::single = $DEBUG;
 252   my($page,$server_response,%headers) =
 253     $self->https_post( { 'Content-Type' => 'application/PTI47',
 254                          'headers' => \%request_header } ,
 255                           $post_data);
 256
 257   warn $page if $DEBUG;
 258
 259   my $response = XMLin($page, KeepRoot => 0);
 260   #$self->Response($response);
 261
 262   #use Data::Dumper;
 263   #warn Dumper($response) if $DEBUG;
 264
 265   my ($r) = values(%$response);
 266   #foreach(qw(ProcStatus RespCode AuthCode AVSRespCode CVV2RespCode)) {
 267   #  if(exists($r->{$_}) and
 268   #     !ref($r->{$_})) {
 269   #    $self->$_($r->{$_});
 270   #  }
 271   #}
 272
 273   foreach (keys %$r) {
 274
 275     #turn empty hashrefs into the empty string
 276     $r->{$_} = '' if ref($r->{$_}) && ! keys %{ $r->{$_} };
 277
 278     #turn hashrefs with content into scalars
 279     $r->{$_} = $r->{$_}{'content'}
 280       if ref($r->{$_}) && exists($r->{$_}{'content'});
 281   }
 282
 283   if ($server_response !~ /^200/) {
 284
 285     #$self->is_success(0);
 286     my $error = "Server error: '$server_response'";
 287     $error .= " / Transaction error: '".
 288               ($r->{'ProcStatusMsg'} || $r->{'StatusMsg'}) . "'"
 289       if $r->{'ProcStatus'} != 0;
 290     #$self->error_message($error);
 291     #overzealous?  are there "normal decline" transaction errors being returned?
 292     die "$error\n";
 293
 294   } else {
 295
 296     die "Unable to parse response_page\n" if !exists($r->{'ProcStatus'});
 297
 298     if ( $r->{'ProcStatus'} != 0 or
 299               # NewOrders get ApprovalStatus, Reversals don't.
 300               ( exists($r->{'ApprovalStatus'}) ?
 301                 $r->{'ApprovalStatus'} != 1 :
 302                 $r->{'StatusMsg'} ne 'Approved' )
 303             )
 304     {
 305
 306       $self->is_success(0);
 307       $self->error_message( "Transaction error: '".
 308                             ($r->{'ProcStatusMsg'} || $r->{'StatusMsg'}) . "'"
 309                           );
 310
 311     } else { # success!
 312
 313       $self->is_success(1);
 314       # For credits, AuthCode is empty and gets converted to a hashref.
 315       $self->authorization($r->{'AuthCode'}) if !ref($r->{'AuthCode'});
 316       $self->order_number($r->{'TxRefNum'});
 317     }
 318
 319   }
 320
 321 }
 322
 323 1;
 324 __END__
 325
 326 =head1 NAME
 327
 328 Business::OnlinePayment::PaymenTech - Chase Paymentech backend for Business::OnlinePayment
 329
 330 =head1 SYNOPSIS
 331
 332   $trans = new Business::OnlinePayment('PaymenTech',
 333     merchant_id     => "000111222333",
 334     terminal_id     => "001",
 335     currency        => "USD", # CAD, MXN
 336   );
 337
 338   $trans->content(
 339     login           => "login",
 340     password        => "password",
 341     type            => "CC",
 342     card_number     => "5500000000000004",
 343     expiration      => "0211",
 344     address         => "123 Anystreet",
 345     city            => "Sacramento",
 346     zip             => "95824",
 347     action          => "Normal Authorization",
 348     amount          => "24.99",
 349   );
 350
 351   $trans->submit;
 352   if($trans->is_approved) {
 353     print "Approved: ".$trans->authorization;
 354   } else {
 355     print "Failed: ".$trans->error_message;
 356   }
 357
 358 =head1 NOTES
 359
 360 Electronic check processing and recurring billing are not yet supported.
 361
 362 =head1 AUTHOR
 363
 364 Mark Wells, mark@freeside.biz
 365
 366 =head1 SEE ALSO
 367
 368 perl(1). L<Business::OnlinePayment>.
 369
 370 =cut
 371