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