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