TD_EFT.pm

   1 package Business::BatchPayment::TD_EFT;
   2
   3 use 5.006;
   4 use strict;
   5 use warnings;
   6 our $VERSION = '0.01';
   7
   8 =head1 NAME
   9
  10 Business::BatchPayment::TD_EFT - TD Commercial Banking EFT1464 batch format
  11
  12 =head1 VERSION
  13
  14 Version 0.01
  15
  16 =head1 USAGE
  17
  18 See L<Business::BatchPayment> for general usage notes.
  19
  20 =head2 SYNOPSIS
  21
  22 use Business::BatchPayment;
  23
  24 my @items = Business::BatchPayment::Item->new( ... );
  25
  26 my $processor = Business::BatchPayment->processor('TD_EFT',
  27   originator      => 'TDABC22334',
  28   datacentre      => '00400',
  29   short_name      => 'AcmeCorp',
  30   long_name       => 'The Acme Corporation',
  31   return_branch   => '10202',   # 0004 + 5-digit branch number
  32   return_account  => '00124598951', # 11 digits
  33   cpa_code        => '120',
  34   # optional, for SFTP file transport
  35   host            => '192.168.100.1',
  36   login           => 'mylogin',
  37   password        => 'mypassword',
  38   # optional, for encryption
  39   encrypt_cmd     => 'compx ASCII DE3',
  40   decrypt_cmd     => 'decompx',
  41   encrypt_key     => '/path/to/encrypt.key',
  42 );
  43
  44 my $result = $processor->submit(@items);
  45
  46 =head2 REQUIREMENTS
  47
  48 Requires L<Net::SFTP::Foreign> and ssh (for file transfer).
  49
  50 =head2 PROCESSOR ATTRIBUTES
  51
  52 =over 4
  53
  54 =item originator - Originator ID, 10 characters
  55
  56 =item datacentre - Your TD datacentre number, 5 digits
  57
  58 =item short_name - Your company name in 15 characters or less.
  59
  60 =item long_name - Your company name in 30 characters or less.
  61
  62 =item return_account, return_branch - The account number and bank branch
  63 to use for returned payments.
  64
  65 =item cpa_code - Your 3-digit CPA industry code.
  66
  67 =back
  68
  69 =head2 TRANSPORT ATTRIBUTES
  70
  71 These need to be specified only if you're using the SFTP transport.
  72
  73 =over 4
  74
  75 =item host - SFTP hostname
  76
  77 =item login - SFTP username
  78
  79 =item password - SFTP password
  80
  81 =item encrypt_cmd - Command to use to encrypt/compress batches before
  82 sending.  This will be called, somewhat awkwardly, with the name of the
  83 output file inserted as the first argument, and the name of the input
  84 file (the plaintext) passed on standard input.  If empty, batches will
  85 be sent as plaintext.
  86
  87 =item descrypt_cmd - Command to decrypt/decompress downloaded batches.
  88
  89 =item encrypt_key - File to copy into the working directory before
  90 running encrypt/decrypt commands.  COMPX requires the encryption key
  91 to be supplied like this.
  92
  93 =back
  94
  95 =cut
  96
  97 use DateTime;
  98 use Try::Tiny;
  99
 100 use Moose;
 101 use Moose::Util::TypeConstraints;
 102
 103 with 'Business::BatchPayment::Processor';
 104
 105 has [ qw( originator short_name long_name
 106           return_branch return_account cpa_code ) ] => (
 107   is  => 'rw',
 108   isa => 'Str',
 109   required => 1,
 110 );
 111
 112 has 'datacentre' => (
 113   is  => 'rw',
 114   isa => enum([qw( 00400 00410 00420 00430 00470 00490)]),
 115   required => 1,
 116 );
 117
 118 has [ qw( login password host encrypt_cmd encrypt_key decrypt_cmd ) ] =>
 119 (
 120   is => 'rw',
 121   isa => 'Str',
 122   required => 0,
 123 ); # only required for the default transport
 124
 125 sub BUILD {
 126   my $self = shift;
 127   # should be a parametric string type or something
 128   $self->originator(     sprintf('%-10.10s', $self->originator)     );
 129   $self->short_name(     sprintf('%-15.15s', $self->short_name)     );
 130   $self->long_name(      sprintf('%-30.30s', $self->long_name)      );
 131   $self->return_account( sprintf('%-11.11s', $self->return_account) . ' ' );
 132   $self->return_branch ( '0004'.
 133     sprintf('%-5.5s', $self->return_branch) )
 134     unless length($self->return_branch) == 9;
 135 }
 136
 137 sub default_transport {
 138   my $self = shift;
 139   Business::BatchPayment->create('TD_EFT::Transport' =>
 140     login     => $self->login,
 141     password  => $self->password,
 142     host      => $self->host,
 143     put_path  => 'APXBA807/',
 144     debug     => $self->debug,
 145     encrypt_cmd => $self->encrypt_cmd,
 146     decrypt_cmd => $self->decrypt_cmd,
 147     encrypt_key => $self->encrypt_key,
 148   );
 149 }
 150
 151
 152 before format_request => sub {
 153   my ($self, $batch) = @_;
 154   #shazam!
 155   Business::BatchPayment::TD_EFT::Batch->meta->apply($batch);
 156
 157   my $dt = DateTime->now;
 158   $dt->set_time_zone('local');
 159   $batch->create_date(sprintf('%03d%03d', $dt->year % 1000, $dt->day_of_year));
 160
 161   my $counter = $batch->batch_id;
 162   $counter = 0 unless $counter =~ /^\d+$/;
 163   # a number from 1 to 9999
 164   $batch->fcn(sprintf('%04u', ($counter % 9999) + 1));
 165   # We can't return the FCN as the batch_id because it wraps around.
 166   # The TIDs are still correct though.
 167 };
 168
 169 sub format_header {
 170   my ($self, $batch) = @_;
 171   $batch->row(1);
 172   my $header =
 173     'A' .          #record type
 174     '000000001' .  #row number
 175     $self->originator .
 176     $batch->fcn .
 177     $batch->create_date .
 178     $self->datacentre;
 179   sprintf('%-1464s', $header);
 180 }
 181
 182 sub format_item {
 183   my ($self, $item, $batch) = @_;
 184
 185   $batch->row($batch->row + 1);
 186   # Avoid floating point error: if we're passed a non-exact number of
 187   # cents (and we will be...), round to the nearest integer, and then
 188   # sum integer numbers of cents to get the batch total.
 189   my $cents = sprintf('%.0f',$item->amount * 100);
 190   if ( $item->action eq 'payment' ) {
 191     $batch->total_payment( $batch->total_payment + $cents );
 192     $batch->count_payment( $batch->count_payment + 1 );
 193   } elsif ( $item->action eq 'credit' ) {
 194     $batch->total_credit(  $batch->total_credit  + $cents );
 195     $batch->count_credit(  $batch->count_credit  + 1 );
 196   }
 197
 198   # default to tomorrow
 199   # (should this use Time::Business?  Date::Holidays::CA?)
 200   # (should we just require the merchant to specify a process date?)
 201   my $process_date = $item->process_date;
 202   if ( $process_date ) {
 203     $process_date->set_time_zone('local');
 204   } else {
 205     $process_date = DateTime->today->set_time_zone('local')->add(days => 1);
 206   }
 207
 208   my $duedate = sprintf('%03d%03d',
 209     $process_date->year % 1000,
 210     $process_date->day_of_year);
 211   # The 1464 byte format supports up to 5 payments per line, but we're
 212   # only sending one.
 213   my $row =
 214     ($item->action eq 'credit' ? 'C' : 'D') .
 215     sprintf('%09u', $batch->row) .
 216     $self->originator .
 217     $batch->fcn .
 218     $self->cpa_code .
 219     sprintf('%010u', $cents) .
 220     $duedate .
 221     sprintf('%09u', $item->routing_code) .
 222     sprintf('%-12.12s', $item->account_number ) .
 223     '0' x 22 .
 224     '0' x 3 .
 225     $self->short_name .
 226     sprintf('%-30.30s', $item->first_name . ' ' . $item->last_name) .
 227     $self->long_name .
 228     $self->originator .
 229     sprintf('%-19.19s', $item->tid) . #originator reference number
 230     $self->return_branch .
 231     $self->return_account .
 232     ' ' x (15 + 22 + 2) .
 233     '0' x 11
 234   ;
 235   sprintf('%-1464s', $row);
 236 }
 237
 238 sub format_trailer {
 239   my ($self, $batch) = @_;
 240   my $trailer =
 241     'Z' .
 242     sprintf('%09u', $batch->row + 1) .
 243     $self->originator .
 244     $batch->fcn .
 245     sprintf('%014u', $batch->total_payment) .
 246     sprintf('%08u', $batch->count_payment) .
 247     sprintf('%014u', $batch->total_credit) .
 248     sprintf('%08u', $batch->count_credit)
 249   ;
 250   sprintf('%-1464s', $trailer);
 251 }
 252
 253 sub parse_response {
 254   # two different response formats to consider
 255   my ($self, $response) = @_;
 256   my $batch = Business::BatchPayment->create('Batch');
 257   Business::BatchPayment::TD_EFT::Batch->meta->apply($batch);
 258
 259   my @rows = split("\n", $response);
 260   if ( length($rows[0]) == 80 and $rows[0] =~ /^H/ ) {
 261     return $self->parse_ret_80($batch, @rows);
 262   } elsif ( length($rows[0]) == 264 and $rows[0] =~ /^A/ ) {
 263     return $self->parse_ack_264($batch, @rows);
 264   } else {
 265     die "can't determine format of file starting with\n$rows[0]\n";
 266   }
 267 }
 268
 269 my @field_order = (
 270   # for error messages in the ACK file
 271   '',
 272   'Record Type',
 273   'Record Count',
 274   'Originator ID',
 275   'File Creation Number',
 276   'CPA Code',
 277   'Payment Amount',
 278   'Due Date',
 279   'Financial Institution ID',
 280   'Payor/Payee Account Number',
 281   '',
 282   '',
 283   'Originator Short Name',
 284   'Payor/Payee Name',
 285   'Originator Long Name',
 286   'Originator ID',
 287   'Originator Reference',
 288   'Return Branch Number',
 289   'Return Account Number',
 290   'Originator Sundry',
 291   '',
 292   '',
 293   ''
 294 );
 295
 296 sub parse_ack_264 {
 297   # TD EFT 264-byte acknowledgement file
 298   # One of these is sent for every batch.  It reports any records
 299   # that failed format screening.
 300   my ($self, $batch, @rows) = @_;
 301   warn "Acknowledgement file" if $self->debug;
 302   my $payment_date;
 303   foreach my $row (@rows) {
 304     try {
 305       if ( $row =~ /^A/ ) {
 306         # Header record.
 307         $row =~ /^(.{1})(.{9})(.{10})(.{4})(.{6})(.{5})(.{7})(.{10})(.{7})(.{10})(.{5})(.{1})(.{30})( {159})$/ or die "invalid header row\n";
 308         # Most of these fields aren't interesting to us.
 309         $batch->fcn($4);
 310         $batch->create_date($5);
 311         my $date = $10;
 312         $date =~ /^(....)-(..)-(..)$/; # actual process date, YYYY-MM-DD
 313         $payment_date = DateTime->new(year => $1, month => $2, day => $3);
 314       } elsif ( $row =~ /^[CD]/ ) {
 315         # Rejected item detail.
 316         my @f = ($row =~ /^(.{1})(.{9})(.{14})(.{3})(.{10})(.{6})(.{9})(.{12})(.{22})(.{3})(.{15})(.{30})(.{30})(.{10})(.{19})(.{9})(.{12})(.{15})(.{22})(.{2})(.{11})$/)
 317           or die "invalid detail row\n";
 318         foreach (@f) { s/^\s+//; s/\s+$//; }
 319         unshift @f,  ''; # make field numbers line up
 320         my $action;
 321         if ( $f[1] eq 'C' ) { $action = 'credit' }
 322         elsif ( $f[1] eq 'D' ) { $action = 'payment' }
 323
 324         my $amount =
 325         my $item = Business::BatchPayment->create('Item' =>
 326           action          => $action,
 327           payment_type    => 'ECHECK',
 328           approved        => 0,
 329           amount          => sprintf('%.2f', $f[5] / 100),
 330           payment_date    => $payment_date,
 331           routing_code    => $f[7],
 332           account_number  => $f[8],
 333           tid             => $f[15],
 334         );
 335         my @error_fields = map { $field_order[$_] } ($f[21] =~ /../g) if $f[21];
 336         $item->error_message('invalid fields: '.join(', ', @error_fields));
 337         $batch->push($item);
 338       } elsif ( $row =~ /^R/ ) {
 339         # um...this indicates the whole batch was rejected
 340         # not quite sure what to do with that
 341         $row =~ /^(.{1})(.{9})(.{10})(.{4})(.{5})(.{75})( {160})$/;
 342         $row = '';
 343         die "batch rejected: $5 $6\n";
 344       } else {
 345         # W, X, Z records
 346         # not interesting
 347       }
 348     } catch {
 349       $self->parse_error($row, $_);
 350     };
 351     die "no valid header row found\n" unless $payment_date;
 352   } #foreach $row
 353   $batch;
 354 }
 355
 356 my %return_reason = (
 357   '00' => 'Edit Reject',
 358   '01' => 'Insufficient Funds',
 359   '02' => 'Cannot Trace',
 360   '03' => 'Payment Stopped/Recalled',
 361   '04' => 'Post/Stale Dated',
 362   '05' => 'Account Closed',
 363   '06' => 'Account Transferred',
 364   '07' => 'No Chequing Privileges',
 365   '08' => 'Funds Not Cleared',
 366   #'09' =>
 367   '10' => 'Payor/Payee Deceased',
 368   '11' => 'Account Frozen',
 369   '12' => 'Invalid/Incorrect Account Number',
 370   '13' => 'Contact Payor/Payee',
 371   '14' => 'Incorrect Payor/Payee Name',
 372   '15' => 'Refused by Payor/Payee',
 373   '80' => 'Payment Recalled',
 374 );
 375
 376 sub parse_ret_80 {
 377   # TD EFT 80 byte returned items file
 378   # This reports unpostable and dishonored payments.
 379   # This may be sent at any time after receiving the request.  If there
 380   # are no dishonored payments, no file will be sent.
 381   my ($self, $batch, @rows) = @_;
 382   warn "Returned item notification" if $self->debug;
 383   my $action;
 384   foreach my $row (@rows) {
 385     try {
 386       if ( $row =~ /^H/ ) {
 387         # Header.
 388         $row =~ /^(.{1})(.{10})(.{1})( {3})(.{6})(.{30})(.{9})(.{12})( {8})$/
 389           or die "invalid header row\n";
 390         # the only field we care about is payment vs. credit
 391         # and even that only minimally
 392         if ( $3 eq 'I' ) {
 393           $action = 'credit'
 394         } elsif ( $3 eq 'J') {
 395           $action = 'payment'
 396         }
 397       } elsif ( $row =~ /^D/ ) {
 398         # Detail.
 399         my @f = ( $row =~ /^(.{1})(.{20})(.{2})(.{1})(.{6})(.{19})(.{9})(.{12})(.{10})$/ )
 400           or die "invalid detail row\n";
 401         foreach (@f) { s/^\s+//; s/\s+$//; }
 402         unshift @f, '';
 403         my $item = Business::BatchPayment->create('Item' =>
 404           action          => $action,
 405           payment_type    => 'ECHECK',
 406           approved        => 0,
 407           amount          => sprintf('%.2f', $f[9] / 100),
 408           routing_code    => $f[7],
 409           account_number  => $f[8],
 410           tid             => $f[6],
 411           error_message   => "$f[3] ".$return_reason{$f[3]},
 412         );
 413         $batch->push($item);
 414       } else {
 415         # T record
 416         # not interesting, though we could use it as an error check
 417       }
 418     } catch {
 419       $self->parse_error($row, $_);
 420     };
 421     die "no valid header row found\n" unless $action;
 422   } #foreach $row
 423   $batch;
 424 }
 425
 426 package Business::BatchPayment::TD_EFT::Batch;
 427 use Moose::Role;
 428 use List::Util qw(sum);
 429
 430 has [qw( create_date fcn )] => ( is => 'rw', isa => 'Str' );
 431 # XXX use the "totals" method instead
 432 has [qw( row total_payment total_credit count_payment count_credit )] =>
 433   ( is => 'rw', isa => 'Int', default => 0 );
 434
 435 =head1 AUTHOR
 436
 437 Mark Wells, C<< <mark at freeside.biz> >>
 438
 439 =head1 BUGS
 440
 441 =head1 SUPPORT
 442
 443 You can find documentation for this module with the perldoc command.
 444
 445     perldoc Business::BatchPayment::TD_EFT
 446
 447 Commercial support is available from Freeside Internet Services, Inc.
 448
 449 L<http://www.freeside.biz>
 450
 451 =head1 ACKNOWLEDGEMENTS
 452
 453 =head1 LICENSE AND COPYRIGHT
 454
 455 Copyright 2012 Mark Wells.
 456
 457 This program is free software; you can redistribute it and/or modify it
 458 under the terms of either: the GNU General Public License as published
 459 by the Free Software Foundation; or the Artistic License.
 460
 461 See http://dev.perl.org/licenses/ for more information.
 462
 463
 464 =cut
 465
 466 1; # End of Business::BatchPayment::TD_EFT