File Coverage

blib/lib/Business/OnlinePayment/SecureHostingUPG.pm

Criterion	Covered	Total	%
statement	28	56	50.0
branch	0	20	0.0
condition	0	9	0.0
subroutine	8	9	88.8
pod	1	4	25.0
total	37	98	37.7

package Business::OnlinePayment::SecureHostingUPG;

use strict;
use Carp;
use Business::OnlinePayment 3;
use Business::OnlinePayment::HTTPS;
use vars qw($VERSION $DEBUG @ISA);

@ISA = qw(Business::OnlinePayment::HTTPS);
$VERSION = '0.03';
$DEBUG = 0;

sub set_defaults {
	my $self = shift;

	$self->server('www.secure-server-hosting.com');
	$self->port('443');
	$self->path('/secutran/transactionjs1.php');

	$self->build_subs(qw(
	  order_number avs_code
	                 ));
        # order_type
	# md5 cvv2_response cavv_response

}

sub submit {
    my($self) = @_;

    #$self->map_fields();
    $self->remap_fields(
        #                => 'order_type',
        #                => 'transaction_type',
        login            => 'shreference',
        password         => 'checkcode',
        #authorization   =>
        #customer_ip     =>
        name             => 'cardholdersname',
        #first_name      =>
        #last_name       =>
        #company         =>
        address          => 'cardholderaddr1',
        #                => 'cardholderaddr2',
        city             => 'cardholdercity',
        state            => 'cardholderstate',
        zip              => 'cardholderpostcode',
        #country         =>
        phone            => 'cardholdertelephonenumber',
        #fax             =>
        email            => 'cardholdersemail',
        card_number      => 'cardnumber',
        #                => 'cardexpiremonth',
        #                => 'cardexpireyear',

        'amount'         => 'transactionamount',
        #invoice_number  =>
        #customer_id     =>
        #order_number    =>

        currency          => 'transactioncurrency',

        #expiration        =>
        cvv2              => 'cv2',
        issue_number      => 'switchnumber',
    );

    die "only Normal Authorization is currently supported"
      unless $self->{_content}{'action'} =~ /^\s*normal\s*authorization\s*$/i;

    #cardexpiremonth & cardexpireyear
    $self->{_content}{'expiration'} =~ /^(\d+)\D+\d*(\d{2})$/
      or croak "unparsable expiration ". $self->{_content}{expiration};
    my( $month, $year ) = ( $1, $2 );
    $month = '0'. $month if $month =~ /^\d$/;
    $self->{_content}{cardexpiremonth} = $month;
    $self->{_content}{cardexpireyear} = $year;

    #cardstartmonth & cardstartyear
    $self->{_content}{'card_start'} =~ /^(\d+)\D+\d*(\d{2})$/
      or croak "unparsable card_start ". $self->{_content}{expiration};
    my( $smonth, $syear ) = ( $1, $2 );
    $smonth = '0'. $smonth if $smonth =~ /^\d$/;
    $self->{_content}{cardstartmonth} = $smonth;
    $self->{_content}{cardstartyear} = $syear;

    $self->required_fields(qw(
      shreference checkcode transactionamount transactioncurrency
      cardexpireyear cardexpiremonth cardstartyear cardstartmonth
      switchnumber cv2 cardnumber cardholdersname cardholdersemail
    ));

    my( $page, $response, @reply_headers) =
      $self->https_post( $self->get_fields( $self->fields ) );
    #my( $page, $response, @reply_headers) =
    #  $self->https_get( $self->get_fields( $self->fields ) );

    #my %reply_headers = @reply_headers;
    #warn join('', map { "  $_ => $reply_headers{$_}\n" } keys %reply_headers )
    #  if $DEBUG;

    #XXX check $response and die if not 200?

    #	avs_code
    #	is_success
    #	result_code
    #	authorization
    #md5 cvv2_response cavv_response ...?

    $self->server_response($page);

    my $result = $self->GetXMLProp($page, 'result');

    if ( defined($result) && $result eq 'success' ) {
      $self->is_success(1);
      $self->avs_code( $self->GetXMLProp($page, 'cv2asvresult') );
    } elsif ( defined($result) && $result eq 'failed' ) {
      $self->is_success(0);
      my $error = '';
      my $tranerrdesc   = $self->GetXMLProp($page, 'tranerrdesc');
      my $tranerrdetail = $self->GetXMLProp($page, 'tranerrdetail');
      $error = $tranerrdesc if defined $tranerrdesc;
      $error .= " - $tranerrdetail"
        if defined $tranerrdetail && length $tranerrdetail;
      $self->error_message($error);
    } else {
      die "unparsable response received from gateway".
          ( $DEBUG ? ": $page" : '' );
    }

}


sub fields {
	my $self = shift;

	qw(
	  shreference
	  checkcode
	  transactionamout
	  transactioncurrency
	  cardexpireyear
	  cardexpiremonth
	  cardstartyear
	  cardstartmonth
	  switchnumber
	  cv2
	  cardnumber
	  cardholdersname
	  cardholdersemail
	  cardholderaddr1
	  cardholderaddr2
	  cardholdercity
	  cardholderstate
	  cardholderpostcode
	  cardholdertelephonenumber
	);
}

sub GetXMLProp {
	my( $self, $raw, $prop ) = @_;
	local $^W=0;

	my $data;
	($data) = $raw =~ m"<$prop>(.*?)"gsi;
	#$data =~ s/<.*?>/ /gs;
	chomp $data;
	return $data;
}

1;

__END__