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