package Business::BatchPayment::TD_EFT;

use 5.006;
use strict;
use warnings;
our $VERSION = '0.01';

=head1 NAME

Business::BatchPayment::TD_EFT - TD Commercial Banking EFT1464 batch format

=head1 VERSION

Version 0.01

=head1 USAGE

See L<Business::BatchPayment> for general usage notes.

=head2 SYNOPSIS

use Business::BatchPayment;

my @items = Business::BatchPayment::Item->new( ... );

my $processor = Business::BatchPayment->processor('TD_EFT',
  originator      => 'TDABC22334',
  datacentre      => '00400',
  short_name      => 'AcmeCorp',
  long_name       => 'The Acme Corporation',
  return_branch   => '10202',   # 0004 + 5-digit branch number
  return_account  => '00124598951', # 11 digits
  cpa_code        => '120',
  # optional, for SFTP file transport
  host            => '192.168.100.1',
  login           => 'mylogin',
  password        => 'mypassword',
  # optional, for encryption
  encrypt_cmd     => 'compx ASCII DE3',
  decrypt_cmd     => 'decompx',
  encrypt_key     => '/path/to/encrypt.key',
);

my $result = $processor->submit(@items);

=head2 REQUIREMENTS

Requires L<Net::SFTP::Foreign> and ssh (for file transfer).

=head2 PROCESSOR ATTRIBUTES

=over 4

=item originator - Originator ID, 10 characters

=item datacentre - Your TD datacentre number, 5 digits

=item short_name - Your company name in 15 characters or less.

=item long_name - Your company name in 30 characters or less.

=item return_account, return_branch - The account number and bank branch
to use for returned payments.

=item cpa_code - Your 3-digit CPA industry code.

=back

=head2 TRANSPORT ATTRIBUTES

These need to be specified only if you're using the SFTP transport.

=over 4

=item host - SFTP hostname

=item login - SFTP username

=item password - SFTP password

=item encrypt_cmd - Command to use to encrypt/compress batches before 
sending.  This will be called, somewhat awkwardly, with the name of the 
output file inserted as the first argument, and the name of the input 
file (the plaintext) passed on standard input.  If empty, batches will
be sent as plaintext.

=item descrypt_cmd - Command to decrypt/decompress downloaded batches.

=item encrypt_key - File to copy into the working directory before 
running encrypt/decrypt commands.  COMPX requires the encryption key
to be supplied like this.

=back

=cut

use DateTime;
use Try::Tiny;

use Moose;
use Moose::Util::TypeConstraints;

with 'Business::BatchPayment::Processor';

has [ qw( originator short_name long_name 
          return_branch return_account cpa_code ) ] => (
  is  => 'rw',
  isa => 'Str',
  required => 1,
);

has 'datacentre' => (
  is  => 'rw',
  isa => enum([qw( 00400 00410 00420 00430 00470 00490)]),
  required => 1,
);

has [ qw( login password host encrypt_cmd encrypt_key decrypt_cmd ) ] =>
(
  is => 'rw',
  isa => 'Str',
  required => 0,
); # only required for the default transport

sub BUILD {
  my $self = shift;
  # should be a parametric string type or something
  $self->originator(     sprintf('%-10.10s', $self->originator)     );
  $self->short_name(     sprintf('%-15.15s', $self->short_name)     );
  $self->long_name(      sprintf('%-30.30s', $self->long_name)      );
  $self->return_account( sprintf('%-11.11s', $self->return_account) . ' ' );
  $self->return_branch ( '0004'.
    sprintf('%-5.5s', $self->return_branch) )
    unless length($self->return_branch) == 9;
}

sub default_transport {
  my $self = shift;
  Business::BatchPayment->create('TD_EFT::Transport' =>
    login     => $self->login,
    password  => $self->password,
    host      => $self->host,
    put_path  => 'APXBA807/',
    debug     => $self->debug,
    encrypt_cmd => $self->encrypt_cmd,
    decrypt_cmd => $self->decrypt_cmd,
    encrypt_key => $self->encrypt_key,
  );
}


before format_request => sub {
  my ($self, $batch) = @_;
  #shazam!
  Business::BatchPayment::TD_EFT::Batch->meta->apply($batch);
  
  my $dt = DateTime->now;
  $dt->set_time_zone('local');
  $batch->create_date(sprintf('%03d%03d', $dt->year % 1000, $dt->day_of_year));

  my $counter = $batch->batch_id;
  $counter = 0 unless $counter =~ /^\d+$/;
  # a number from 1 to 9999
  $batch->fcn(sprintf('%04u', ($counter % 9999) + 1));
  # We can't return the FCN as the batch_id because it wraps around.
  # The TIDs are still correct though.
};

sub format_header {
  my ($self, $batch) = @_;
  $batch->row(1);
  my $header =
    'A' .          #record type
    '000000001' .  #row number
    $self->originator .
    $batch->fcn .
    $batch->create_date .
    $self->datacentre;
  sprintf('%-1464s', $header);
}

sub format_item {
  my ($self, $item, $batch) = @_;

  $batch->row($batch->row + 1);
  # Avoid floating point error: if we're passed a non-exact number of
  # cents (and we will be...), round to the nearest integer, and then
  # sum integer numbers of cents to get the batch total.
  my $cents = sprintf('%.0f',$item->amount * 100);
  if ( $item->action eq 'payment' ) {
    $batch->total_payment( $batch->total_payment + $cents );
    $batch->count_payment( $batch->count_payment + 1 );
  } elsif ( $item->action eq 'credit' ) {
    $batch->total_credit(  $batch->total_credit  + $cents );
    $batch->count_credit(  $batch->count_credit  + 1 );
  }

  # default to tomorrow
  # (should this use Time::Business?  Date::Holidays::CA?)
  # (should we just require the merchant to specify a process date?)
  my $process_date = $item->process_date;
  if ( $process_date ) {
    $process_date->set_time_zone('local');
  } else {
    $process_date = DateTime->today->set_time_zone('local')->add(days => 1);
  }

  my $duedate = sprintf('%03d%03d', 
    $process_date->year % 1000,
    $process_date->day_of_year);
  # The 1464 byte format supports up to 5 payments per line, but we're 
  # only sending one.
  my $row =
    ($item->action eq 'credit' ? 'C' : 'D') .
    sprintf('%09u', $batch->row) .
    $self->originator .
    $batch->fcn .
    $self->cpa_code .
    sprintf('%010u', $cents) .
    $duedate .
    sprintf('%09u', $item->routing_code) .
    sprintf('%-12.12s', $item->account_number ) .
    '0' x 22 .
    '0' x 3 .
    $self->short_name .
    sprintf('%-30.30s', $item->first_name . ' ' . $item->last_name) .
    $self->long_name .
    $self->originator .
    sprintf('%-19.19s', $item->tid) . #originator reference number
    $self->return_branch .
    $self->return_account .
    ' ' x (15 + 22 + 2) .
    '0' x 11
  ;
  sprintf('%-1464s', $row);
}

sub format_trailer {
  my ($self, $batch) = @_;
  my $trailer =
    'Z' .
    sprintf('%09u', $batch->row + 1) .
    $self->originator .
    $batch->fcn .
    sprintf('%014u', $batch->total_payment) .
    sprintf('%08u', $batch->count_payment) .
    sprintf('%014u', $batch->total_credit) .
    sprintf('%08u', $batch->count_credit)
  ;
  sprintf('%-1464s', $trailer);
}

sub parse_response {
  # two different response formats to consider
  my ($self, $response) = @_;
  my $batch = Business::BatchPayment->create('Batch');
  Business::BatchPayment::TD_EFT::Batch->meta->apply($batch);

  my @rows = split("\n", $response);
  if ( length($rows[0]) == 80 and $rows[0] =~ /^H/ ) {
    return $self->parse_ret_80($batch, @rows);
  } elsif ( length($rows[0]) == 264 and $rows[0] =~ /^A/ ) {
    return $self->parse_ack_264($batch, @rows);
  } else {
    die "can't determine format of file starting with\n$rows[0]\n";
  }
}

my @field_order = (
  # for error messages in the ACK file
  '',
  'Record Type',
  'Record Count',
  'Originator ID',
  'File Creation Number',
  'CPA Code',
  'Payment Amount',
  'Due Date',
  'Financial Institution ID',
  'Payor/Payee Account Number',
  '',
  '',
  'Originator Short Name',
  'Payor/Payee Name',
  'Originator Long Name',
  'Originator ID',
  'Originator Reference',
  'Return Branch Number',
  'Return Account Number',
  'Originator Sundry',
  '',
  '',
  ''
);

sub parse_ack_264 {
  # TD EFT 264-byte acknowledgement file
  # One of these is sent for every batch.  It reports any records
  # that failed format screening.
  my ($self, $batch, @rows) = @_;
  warn "Acknowledgement file" if $self->debug;
  my $payment_date;
  foreach my $row (@rows) {
    try {
      if ( $row =~ /^A/ ) {
        # Header record.
        $row =~ /^(.{1})(.{9})(.{10})(.{4})(.{6})(.{5})(.{7})(.{10})(.{7})(.{10})(.{5})(.{1})(.{30})( {159})$/ or die "invalid header row\n";
        # Most of these fields aren't interesting to us.
        $batch->fcn($4);
        $batch->create_date($5);
        my $date = $10;
        $date =~ /^(....)-(..)-(..)$/; # actual process date, YYYY-MM-DD
        $payment_date = DateTime->new(year => $1, month => $2, day => $3);
      } elsif ( $row =~ /^[CD]/ ) {
        # Rejected item detail.
        my @f = ($row =~ /^(.{1})(.{9})(.{14})(.{3})(.{10})(.{6})(.{9})(.{12})(.{22})(.{3})(.{15})(.{30})(.{30})(.{10})(.{19})(.{9})(.{12})(.{15})(.{22})(.{2})(.{11})$/)
          or die "invalid detail row\n";
        foreach (@f) { s/^\s+//; s/\s+$//; }
        unshift @f,  ''; # make field numbers line up
        my $action;
        if ( $f[1] eq 'C' ) { $action = 'credit' }
        elsif ( $f[1] eq 'D' ) { $action = 'payment' }

        my $amount = 
        my $item = Business::BatchPayment->create('Item' =>
          action          => $action,
          payment_type    => 'ECHECK',
          approved        => 0,
          amount          => sprintf('%.2f', $f[5] / 100),
          payment_date    => $payment_date,
          routing_code    => $f[7],
          account_number  => $f[8],
          tid             => $f[15],
        );
        my @error_fields = map { $field_order[$_] } ($f[21] =~ /../g) if $f[21];
        $item->error_message('invalid fields: '.join(', ', @error_fields));
        $batch->push($item);
      } elsif ( $row =~ /^R/ ) {
        # um...this indicates the whole batch was rejected
        # not quite sure what to do with that
        $row =~ /^(.{1})(.{9})(.{10})(.{4})(.{5})(.{75})( {160})$/;
        $row = '';
        die "batch rejected: $5 $6\n";
      } else {
        # W, X, Z records
        # not interesting
      }
    } catch {
      $self->parse_error($row, $_);
    };
    die "no valid header row found\n" unless $payment_date;
  } #foreach $row
  $batch;
}

my %return_reason = (
  '00' => 'Edit Reject',
  '01' => 'Insufficient Funds',
  '02' => 'Cannot Trace',
  '03' => 'Payment Stopped/Recalled',
  '04' => 'Post/Stale Dated',
  '05' => 'Account Closed',
  '06' => 'Account Transferred',
  '07' => 'No Chequing Privileges',
  '08' => 'Funds Not Cleared',
  #'09' => 
  '10' => 'Payor/Payee Deceased',
  '11' => 'Account Frozen',
  '12' => 'Invalid/Incorrect Account Number',
  '13' => 'Contact Payor/Payee',
  '14' => 'Incorrect Payor/Payee Name',
  '15' => 'Refused by Payor/Payee',
  '80' => 'Payment Recalled',
);

sub parse_ret_80 {
  # TD EFT 80 byte returned items file
  # This reports unpostable and dishonored payments.
  # This may be sent at any time after receiving the request.  If there
  # are no dishonored payments, no file will be sent.
  my ($self, $batch, @rows) = @_;
  warn "Returned item notification" if $self->debug;
  my $action;
  foreach my $row (@rows) {
    try {
      if ( $row =~ /^H/ ) {
        # Header.
        $row =~ /^(.{1})(.{10})(.{1})( {3})(.{6})(.{30})(.{9})(.{12})( {8})$/
          or die "invalid header row\n";
        # the only field we care about is payment vs. credit
        # and even that only minimally
        if ( $3 eq 'I' ) {
          $action = 'credit'
        } elsif ( $3 eq 'J') {
          $action = 'payment'
        }
      } elsif ( $row =~ /^D/ ) {
        # Detail.
        my @f = ( $row =~ /^(.{1})(.{20})(.{2})(.{1})(.{6})(.{19})(.{9})(.{12})(.{10})$/ )
          or die "invalid detail row\n";
        foreach (@f) { s/^\s+//; s/\s+$//; }
        unshift @f, '';
        my $item = Business::BatchPayment->create('Item' =>
          action          => $action,
          payment_type    => 'ECHECK',
          approved        => 0,
          amount          => sprintf('%.2f', $f[9] / 100),
          routing_code    => $f[7],
          account_number  => $f[8],
          tid             => $f[6],
          error_message   => "$f[3] ".$return_reason{$f[3]},
        );
        $batch->push($item);
      } else {
        # T record
        # not interesting, though we could use it as an error check
      }
    } catch {
      $self->parse_error($row, $_);
    };
    die "no valid header row found\n" unless $action;
  } #foreach $row
  $batch;
}

package Business::BatchPayment::TD_EFT::Batch;
use Moose::Role;
use List::Util qw(sum);

has [qw( create_date fcn )] => ( is => 'rw', isa => 'Str' );
# XXX use the "totals" method instead
has [qw( row total_payment total_credit count_payment count_credit )] =>
  ( is => 'rw', isa => 'Int', default => 0 );

=head1 AUTHOR

Mark Wells, C<< <mark at freeside.biz> >>

=head1 BUGS

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Business::BatchPayment::TD_EFT

Commercial support is available from Freeside Internet Services, Inc.

L<http://www.freeside.biz>

=head1 ACKNOWLEDGEMENTS

=head1 LICENSE AND COPYRIGHT

Copyright 2012 Mark Wells.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of Business::BatchPayment::TD_EFT
