From 1bd6506437d1329616ee97321187b1868f6a76de Mon Sep 17 00:00:00 2001 From: Mark Wells Date: Thu, 31 Jan 2013 20:16:10 -0800 Subject: [PATCH] changes for cardfortress --- BatchPayment/Batch.pm | 58 ++++++++++++++++++++++++++++++++++- BatchPayment/Item.pm | 67 +++++++++++++++++++++++++++++++++++++++-- BatchPayment/Processor.pm | 8 +++-- BatchPayment/Transport/HTTPS.pm | 21 ++++++++----- 4 files changed, 142 insertions(+), 12 deletions(-) diff --git a/BatchPayment/Batch.pm b/BatchPayment/Batch.pm index 0d6176b..16f1738 100644 --- a/BatchPayment/Batch.pm +++ b/BatchPayment/Batch.pm @@ -21,20 +21,42 @@ but usually must be a positive integer, if it's used at all. Processor modules may include C in a reply batch ONLY if it is guaranteed to match the batch_id of a request batch AND all the items in the reply batch come from that request batch. Otherwise, -C must be null. It must always be null when using one-way +C must be undef. It must always be undef when using one-way (receive-only) workflow, since there are no request batches. +=item process_date - The intended processing date for a request batch. +If not set, it will default to the start of the next day; if that's +not what you want, set it explicitly. + =item items - An arrayref of L objects included in the batch. +=item num + +If your processor uses C and C, this will +be set to 0 by C and incremented every time C +is called. Convenient for formats that require record numbers. + =back +=head1 METHODS + +=over 4 + +=item totals + +Returns a hash containing 'credit_count', 'credit_sum', 'payment_count', +and 'payment_sum'. These are the number of credits, sum of credit amounts, +number of payments, and sum of payment amounts. + =cut package Business::BatchPayment::Batch; use strict; use Moose; +use Moose::Util::TypeConstraints; +use DateTime; has incoming => ( is => 'rw', @@ -59,4 +81,38 @@ has items => ( default => sub { [] }, ); +class_type 'DateTime'; +coerce 'DateTime', from 'Int', via { DateTime->from_epoch($_) }; + +has process_date => ( + is => 'rw', + isa => 'DateTime', + coerce => 1, + default => sub { +# warn "No batch process date set; assuming tomorrow.\n"; + DateTime->today->add(days => 1); + }, +); + +has num => ( + is => 'rw', + isa => 'Maybe[Int]', +); + +sub totals { + my $self = shift; + my %totals = map {$_ => 0} + qw(credit_count credit_sum payment_count payment_sum); + foreach ($self->elements) { + if ($_->action eq 'credit') { + $totals{credit_count}++; + $totals{credit_sum} += $_->amount; + } elsif ( $_->action eq 'payment') { + $totals{payment_count}++; + $totals{payment_sum} += $_->amount; + } + } + %totals; +} + 1; diff --git a/BatchPayment/Item.pm b/BatchPayment/Item.pm index d9a3ec7..8a203ac 100644 --- a/BatchPayment/Item.pm +++ b/BatchPayment/Item.pm @@ -106,6 +106,10 @@ Company name. Billing address fields. Credit card processors may use these (especially zip) for authentication. +=item phone + +Customer phone number. + =cut has [ qw( @@ -119,6 +123,7 @@ has [ qw( state country zip + phone ) ] => ( is => 'rw', isa => 'Str', default => '' ); =back @@ -129,7 +134,9 @@ has [ qw( =item process_date -The date requested for processing. +The date requested for processing. This is meaningful only if the +processor allows different processing dates for items in the same +batch. =item invoice_number @@ -193,7 +200,54 @@ Credit card expiration, MMYY format. =cut has card_number => ( is => 'rw', isa => 'Str' ); -has expiration => ( is => 'rw', isa => 'Str' ); +has ['expiration_month', 'expiration_year'] => ( is => 'rw', isa => 'Int' ); + +sub expiration { + # gets/sets expiration_month and _year in MMYY format + my $self = shift; + my $arg = shift; + if ( $arg ) { + # well, we said it's in MMYY format + my ($m, $y) = _parse_expiration($arg); + $self->expiration_month($m); + $self->expiration_year($y); + } + return sprintf('%02d/%02d', + $self->expiration_month, + $self->expiration_year % 2000); +} + +sub _parse_expiration { + my $arg = shift; + if ( $arg =~ /^(\d\d)(\d\d)$/ ) { + return ($1, 2000 + $2); + } elsif ( $arg =~ /^(\d\d?)\W(\d\d)$/ ) { + return ($1, 2000 + $2); + } elsif ( $arg =~ /^(\d\d?)\W(\d\d\d\d)$/ ) { + return ($1, $2); + } elsif ( $arg =~ /^(\d\d?)\W\d\d?\W(\d\d\d\d)$/) { + return ($1, $3); + } else { + die "can't parse expiration date '$arg'"; + } +} + +sub payinfo { + # gets/sets either the card number, or the account number + routing code + # depending on the payment type + my $self = shift; + if ( $self->payment_type eq 'CC' ) { + $self->card_number(@_); + } elsif ( $self->payment_type eq 'ECHECK' ) { + my $arg = shift; + if ( $arg ) { + $arg =~ /^(\d+)@(\d+)$/ or die "Validation failed for payinfo"; + $self->account_number($1); + $self->routing_code($2); + } + return ($self->account_number . '@' . $self->routing_code); + } +} =back @@ -273,6 +327,15 @@ has [qw( has check_number => ( is => 'rw', isa => 'Int' ); +around 'BUILDARGS' => sub { + my ($orig, $self, %args) = @_; + if ( $args{expiration} ) { + @args{'expiration_month', 'expiration_year'} = + _parse_expiration($args{expiration}); + } + $self->$orig(%args); +}; + __PACKAGE__->meta->make_immutable; 1; diff --git a/BatchPayment/Processor.pm b/BatchPayment/Processor.pm index e02259a..a148c16 100644 --- a/BatchPayment/Processor.pm +++ b/BatchPayment/Processor.pm @@ -219,7 +219,7 @@ sub submit { warn $request if $self->debug >= 2; $self->transport->upload($request); } -; + sub receive { my $self = shift; my @responses = $self->transport->download; @@ -237,9 +237,11 @@ sub format_request { my $self = shift; my $batch = shift; my $output = $self->format_header($batch); + $batch->num(0); foreach my $item ($batch->elements) { try { $output .= $self->format_item($item, $batch); + $batch->num( $batch->num + 1 ); } catch { $self->format_error($item, $_); }; @@ -253,12 +255,14 @@ sub parse_response { my $input = shift; my $batch = Business::BatchPayment->create(Batch => incoming => $self->incoming, - batch_id => $self->parse_batch_id($input) + batch_id => $self->parse_batch_id($input), + num => 0, ); while ( $input =~ s/(.*)\n//m ) { my $row = $1; try { $batch->push( $self->parse_item($row) ); + $batch->num( $batch->num + 1 ); } catch { $self->parse_error($row, $_); }; diff --git a/BatchPayment/Transport/HTTPS.pm b/BatchPayment/Transport/HTTPS.pm index fdb2c35..0eb783b 100644 --- a/BatchPayment/Transport/HTTPS.pm +++ b/BatchPayment/Transport/HTTPS.pm @@ -14,29 +14,36 @@ use Net::HTTPS::Any 0.10; with 'Business::BatchPayment::Transport'; has [ qw( host port get_path put_path ) ] => ( - is => 'ro', + is => 'rw', isa => 'Str' ); has 'content_type' => ( is => 'rw', isa => 'Str', - default => 'text/plain' + default => '', # application/x-www-form-urlencoded ); sub https_post { my $self = shift; my $path = shift; my $content = shift; - - warn "starting https_post...\n" if $self->debug; - my ( $page, $response, %reply_headers ) = Net::HTTPS::Any::https_post( + my %post = ( host => $self->host, port => $self->port, path => $path, - content => $content, - debug => ($self->debug >= 3), + debug => ($self->debug > 3 ? 1 : 0), + 'Content-Type' => $self->content_type ); + if (ref $content and ref $content eq 'HASH') { + $post{'args'} = $content; + } else { + $post{'content'} = $content; + } + + warn "starting https_post...\n" if $self->debug; + my ( $page, $response, %reply_headers ) = Net::HTTPS::Any::https_post(%post); + warn "PAGE:\n$page\n\nRESPONSE:\n$response\n\n" if $self->debug >= 2; return ($page, $response, %reply_headers); } -- 2.11.0