add upload of batch result from TD Canada Trust

some global.asa / handler.pl enhancements

diff --git a/FS/FS/cust_pay_batch.pm b/FS/FS/cust_pay_batch.pm
index 1a53046..97c1681 100644 (file)
--- a/FS/FS/cust_pay_batch.pm
+++ b/FS/FS/cust_pay_batch.pm
@@ -2,7 +2,7 @@ package FS::cust_pay_batch;
 
 use strict;
 use vars qw( @ISA );
 
 use strict;
 use vars qw( @ISA );

-use FS::Record;
+use FS::Record qw(dbh qsearchs);

 use Business::CreditCard;
 
 @ISA = qw( FS::Record );
 use Business::CreditCard;
 
 @ISA = qw( FS::Record );


@@ -190,9 +190,141 @@ sub check {
 
 =back
 
 
 =back
 

-=head1 VERSION
+=head1 SUBROUTINES

 
 

-$Id: cust_pay_batch.pm,v 1.7 2003-08-05 00:20:42 khoff Exp $
+=over 4
+
+=item import_results
+
+=cut
+
+sub import_results {
+  use Time::Local;
+  use FS::cust_pay;
+  eval "use Text::CSV_XS;";
+  die $@ if $@;
+#
+  my $param = shift;
+  my $fh = $param->{'filehandle'};
+  my $format = $param->{'format'};
+  my $paybatch = $param->{'paybatch'};
+
+  my @fields;
+  my $condition;
+  my $hook;
+
+  if ( $format eq 'csv-td_canada_trust-merchant_pc_batch' ) {
+
+    @fields = (
+      'paybatchnum', # Reference#:  Invoice number of the transaction
+      'paid',        # Amount:  Amount of the transaction.  Dollars and cents
+                     #          with no decimal entered.
+      '',            # Card Type:  0 - MCrd, 1 - Visa, 2 - AMEX, 3 - Discover,
+                     #             4 - Insignia, 5 - Diners/EnRoute, 6 - JCB
+      '_date',       # Transaction Date:  Date the Transaction was processed
+      'time',        # Transaction Time:  Time the transaction was processed
+      'payinfo',     # Card Number:  Card number for the transaction
+      '',            # Expiry Date:  Expiry date of the card
+      '',            # Auth#:  Authorization number entered for force post
+                     #         transaction
+      'type',        # Transaction Type:  0 - purchase, 40 - refund,
+                     #                    20 - force post
+      'result',      # Processing Result: 3 - Approval,
+                     #                    4 - Declined/Amount over limit,
+                     #                    5 - Invalid/Expired/stolen card,
+                     #                    6 - Comm Error
+      '',            # Terminal ID: Terminal ID used to process the transaction
+    );
+
+    $condition = sub {
+      my $hash = shift;
+      $hash->{'result'} == 3 && $hash->{'type'} == 0;
+    };
+
+    $hook = sub {
+      my $hash = shift;
+      $hash->{'paid'} = sprintf("%.2f", $hash->{'paid'} / 100 );
+      $hash->{'_date'} = timelocal( substr($hash->{'time'},  4, 2),
+                                    substr($hash->{'time'},  2, 2),
+                                    substr($hash->{'time'},  0, 2),
+                                    substr($hash->{'_date'}, 6, 2),
+                                    substr($hash->{'_date'}, 4, 2)-1,
+                                    substr($hash->{'_date'}, 0, 4)-1900, );
+    };
+
+  } else {
+    return "Unknown format $format";
+  }
+
+  my $csv = new Text::CSV_XS;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $line;
+  while ( defined($line=<$fh>) ) {
+
+    $csv->parse($line) or do {
+      $dbh->rollback if $oldAutoCommit;
+      return "can't parse: ". $csv->error_input();
+    };
+
+    my @values = $csv->fields();
+    my %hash;
+    foreach my $field ( @fields ) {
+      my $value = shift @values;
+      next unless $field;
+      $hash{$field} = $value;
+    }
+
+    my $cust_pay_batch =
+      qsearchs('cust_pay_batch', { 'paybatchnum' => $hash{'paybatchnum'} } );
+    unless ( $cust_pay_batch ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "unknown paybatchnum $hash{'paybatchnum'}\n";
+    }
+    my $custnum = $cust_pay_batch->custnum,
+
+    my $error = $cust_pay_batch->delete;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "error removing paybatchnum $hash{'paybatchnum'}: $error\n";
+    }
+
+    next unless &{$condition}(\%hash);
+
+    &{$hook}(\%hash);
+
+    my $cust_pay = new FS::cust_pay ( {
+      'custnum'  => $custnum,
+      'payby'    => 'CARD',
+      'paybatch' => $paybatch,
+      map { $_ => $hash{$_} } (qw( paid _date payinfo )),
+    } );
+    $error = $cust_pay->insert;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "error adding payment paybatchnum $hash{'paybatchnum'}: $error\n";
+    }
+
+    $cust_pay->cust_main->apply_payments;
+
+  }
+  
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
+=back

 
 =head1 BUGS
 
 
 =head1 BUGS
 

diff --git a/htetc/global.asa b/htetc/global.asa
index 5b0ac49..f00ae57 100644 (file)
--- a/htetc/global.asa
+++ b/htetc/global.asa
@@ -9,6 +9,7 @@ use CGI;
 use Date::Format;
 use Date::Parse;
 use Time::Local;
 use Date::Format;
 use Date::Parse;
 use Time::Local;

+use File::Basename;

 use Tie::IxHash;
 use HTML::Entities;
 use IO::Handle;
 use Tie::IxHash;
 use HTML::Entities;
 use IO::Handle;


@@ -195,5 +196,36 @@ sub include {
   $Response->Include(@_);
 }
 
   $Response->Include(@_);
 }
 

+if ( defined(@DBIx::Profile::ISA) ) {
+
+  #false laziness w/above
+  *redirect = sub {
+    my($location) = @_;
+
+    ${$Response->{BinaryRef}} = 
+      $cgi->header.
+      qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
+      '<BR><BR><PRE>'.
+        ( UNIVERSAL::can(dbh, 'sprintProfile')
+            ? encode_entities(dbh->sprintProfile())
+            : 'DBIx::Profile missing sprintProfile method;'.
+              'unpatched or too old?'                        ).
+      "\n\n". &sprintAutoProfile().  '</PRE>'.
+      '</BODY></HTML>';
+
+    dbh->{'private_profile'} = {};
+
+    $Response->End;
+
+  };
+
+} else {
+
+  *redirect = sub {
+    $Response->Redirect(@_);
+  }
+
+}
+

 1;
 
 1;
 

diff --git a/htetc/handler.pl b/htetc/handler.pl
index 8f079af..1660cb3 100644 (file)
--- a/htetc/handler.pl
+++ b/htetc/handler.pl
@@ -67,6 +67,7 @@ sub handler
       use Date::Format;
       use Date::Parse;
       use Time::Local;
       use Date::Format;
       use Date::Parse;
       use Time::Local;

+      use File::Basename;

       use Tie::IxHash;
       use HTML::Entities;
       use IO::Handle;
       use Tie::IxHash;
       use HTML::Entities;
       use IO::Handle;


@@ -141,20 +142,10 @@ sub handler
 
         } else { #normal redirect
 
 
         } else { #normal redirect
 

-          #http://www.masonhq.com/docs/faq/#how_do_i_do_an_external_redirect
-          $m->clear_buffer;
-          # The next two lines are necessary to stop Apache from re-reading
-          # POSTed data.
-          $r->method('GET');
-          $r->headers_in->unset('Content-length');
-          $r->content_type('text/html');
-          #$r->err_header_out('Location' => $location);
-          $r->header_out('Location' => $location);
-          $r->header_out('Content-Type' => 'text/html');
-          $m->abort(302);
-
+          $m->redirect($location);

           '';
           '';

-         }
+
+        }

 
       };
 
 
       };
 


@@ -168,6 +159,36 @@ sub handler
         $m->scomp(@_);
       }
 
         $m->scomp(@_);
       }
 

+      sub redirect {
+        my( $location ) = @_;
+        use vars qw($m);
+        $m->clear_buffer;
+        #false laziness w/above
+        if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect
+
+          $m->print(
+            qq!<HTML><BODY>Redirect to <A HREF="$location">$location</A>!.
+            '<BR><BR><PRE>'.
+              ( UNIVERSAL::can(dbh, 'sprintProfile')
+                  ? encode_entities(dbh->sprintProfile())
+                  : 'DBIx::Profile missing sprintProfile method;'.
+                    'unpatched or too old?'                        ).
+            #"\n\n". &sprintAutoProfile().  '</PRE>'.
+            "\n\n".                         '</PRE>'.
+            '</BODY></HTML>'
+          );
+          dbh->{'private_profile'} = {};
+
+          $m->abort(200);
+
+        } else { #normal redirect
+
+          $m->redirect($location);
+
+        }
+
+      }
+

     } # end package HTML::Mason::Commands;
 
     $r->content_type('text/html');
     } # end package HTML::Mason::Commands;
 
     $r->content_type('text/html');

diff --git a/httemplate/browse/cust_pay_batch.cgi b/httemplate/browse/cust_pay_batch.cgi
index f9d0921..d90a033 100755 (executable)
--- a/httemplate/browse/cust_pay_batch.cgi
+++ b/httemplate/browse/cust_pay_batch.cgi
@@ -2,11 +2,18 @@
 <%= header("Pending credit card batch", menubar( 'Main Menu' => $p,)) %>
 
 <FORM ACTION="<%=$p%>misc/download-batch.cgi" METHOD="POST">
 <%= header("Pending credit card batch", menubar( 'Main Menu' => $p,)) %>
 
 <FORM ACTION="<%=$p%>misc/download-batch.cgi" METHOD="POST">

-

 Download batch in format <SELECT NAME="format">
 Download batch in format <SELECT NAME="format">

-<OPTION VALUE="csv">Generic CSV (comma-separated value)</OPTION>

 <OPTION VALUE="csv-td_canada_trust-merchant_pc_batch">CSV file for TD Canada Trust Merchant PC Batch</OPTION>
 <OPTION VALUE="csv-td_canada_trust-merchant_pc_batch">CSV file for TD Canada Trust Merchant PC Batch</OPTION>

-</SELECT><INPUT TYPE="submit" VALUE="Download">
+</SELECT><INPUT TYPE="submit" VALUE="Download"></FORM>
+<BR><BR>
+
+<FORM ACTION="<%=$p%>misc/upload-batch.cgi" METHOD="POST" ENCTYPE="multipart/form-data">
+Upload results<BR>
+Filename <INPUT TYPE="file" NAME="batch_results"><BR>
+Format <SELECT NAME="format">
+<OPTION VALUE="csv-td_canada_trust-merchant_pc_batch">CSV results from TD Canada Trust Merchant PC Batch</OPTION>
+</SELECT><BR>
+<INPUT TYPE="submit" VALUE="Upload"></FORM>

 <BR><BR>
 
 <%= &table() %>
 <BR><BR>
 
 <%= &table() %>

diff --git a/httemplate/misc/upload-batch.cgi b/httemplate/misc/upload-batch.cgi
new file mode 100644 (file)
index 0000000..565a6da
--- /dev/null
+++ b/httemplate/misc/upload-batch.cgi
@@ -0,0 +1,28 @@
+<%
+
+  my $fh = $cgi->upload('batch_results');
+  my $filename = $cgi->param('batch_results');
+  my $paybatch = basename($filename);
+
+  my $error = defined($fh)
+    ? FS::cust_pay_batch::import_results( {
+        'filehandle' => $fh,
+        'format'     => $cgi->param('format'),
+        'paybatch'   => $paybatch,
+      } )
+    : 'No file';
+
+  if ( $error ) {
+    %>
+    <!-- mason kludge -->
+    <%
+    eidiot($error);
+#    $cgi->param('error', $error);
+#    print $cgi->redirect( "${p}cust_main-import.cgi
+  } else {
+    %>
+    <!-- mason kludge -->
+    <%= header('Batch results upload sucessful') %> <%
+  }
+%>
+