Saving current state of code, and adding test script i'm using. just put the new module with its peers (/usr/share/perl5/Business/...)

2 files changed, 108 insertions, 36 deletions

diff --git a/test.pl b/test.pl
index 22124bd..4c76fd8 100644
--- a/test.pl
+++ b/test.pl
@@ -14,7 +14,8 @@ my %opt = (
     gid => '1432479912596791',
     tid => '01',
     userid=> 'tom@yiptv.com',
-    port => 443
+    port => 443,
+    env => 'test'
 );
 
 
diff --git a/vSecureProcessing.pm b/vSecureProcessing.pm
index cd1e30f..69a3ed0 100644
--- a/vSecureProcessing.pm
+++ b/vSecureProcessing.pm
@@ -6,9 +6,11 @@ use Carp;
 use Template;
 use XML::Simple;
 use Data::Dumper;
+use MIME::Entity;
 
 use Business::OnlinePayment;
 use Business::OnlinePayment::HTTPS;
+use Net::SSLeay qw(post_http post_https make_headers make_form);
 use vars qw($VERSION $DEBUG @ISA $me);
 
 @ISA = qw(Business::OnlinePayment::HTTPS);
@@ -67,6 +69,60 @@ my %action_mapping = (
 	# void => void
 );
 
+BEGIN{
+eval 'use bytes; sub blength ($) { length $_[0] }';
+$@ and eval '    sub blength ($) { length $_[0] }' ;
+}
+sub Net::SSLeay::do_httpx3 {
+    my ($method, $usessl, $site, $port, $path, $headers,
+        $content, $mime_type, $crt_path, $key_path) = @_;
+    my ($response, $page, $h,$v);
+	my $CRLF = "\x0d\x0a";  # because \r\n is not fully portable
+    if ($content) {
+        $mime_type = "";#application/x-www-form-urlencoded" unless $mime_type;
+        my $len = blength($content);
+        #$content = "$mime_type${CRLF}Content-Length: $len$CRLF$CRLF$content";
+        $content = "Cache-Control: no-cache$CRLF"
+        	. "Content-Type: multipart/form-data; boundary=----FormBoundaryE19zNvXGzXaLvS5C$CRLF"
+        	. "Accept: */*$CRLF"
+            . "Content-Length: $len$CRLF$CRLF$content";
+    } else {
+        $content = "$CRLF$CRLF";
+    }
+    my $req = "$method $path HTTP/1.1$CRLF";
+    unless (defined $headers && $headers =~ /^Host:/m) {
+        $req .= "Host: $site";
+        unless (($port == 80 && !$usessl) || ($port == 443 && $usessl)) {
+            $req .= ":$port";
+        }
+        $req .= $CRLF;
+    }
+    $req .= (defined $headers ? $headers : '') . "$content";
+
+    warn "do_httpx3($method,$usessl,$site:$port)" if $DEBUG;
+    my ($http, $errs, $server_cert)
+        = Net::SSLeay::httpx_cat($usessl, $site, $port, $req, $crt_path, $key_path);
+    return (undef, "HTTP/1.0 900 NET OR SSL ERROR$CRLF$CRLF$errs") if $errs;
+
+    $http = '' if !defined $http;
+    ($headers, $page) = split /\s?\n\s?\n/, $http, 2;
+    warn "headers >$headers< page >>$page<< http >>>$http<<<" if $DEBUG>1;
+    ($response, $headers) = split /\s?\n/, $headers, 2;
+    return ($page, $response, $headers, $server_cert);
+};
+
+sub Net::SSLeay::make_form {
+    my (@fields) = @_;
+    my $form;
+    while (@fields) {
+        my ($name, $data) = (shift(@fields), shift(@fields));
+#       $data =~ s/([^\w\-.\@\$ ])/sprintf("%%%2.2x",ord($1))/gse;
+#       $data =~ tr[ ][+];
+        $form .= "$name=$data&";
+    }
+    chop $form;
+    return $form;
+}
 
 sub set_defaults {
 	my $self = shift;
@@ -94,7 +150,7 @@ sub set_defaults {
     
     $DEBUG = exists($options{debug}) ? $options{debug} : $DEBUG;
     
-    $self->port($options{'port'});
+    
     
     $self->server($options{'url'});
     
@@ -106,8 +162,10 @@ sub set_defaults {
     
     $self->appid($options{'appid'});
     
-    $self->env($options{'env'}) if (defined($options{'env'})); # 'live'/'test'
+    $self->env((defined($options{'env'})) ? $options{'env'} : 'live'); # 'live'/'test'
 	
+# 	$self->port(($options{'env'} eq 'test') ? 80 : 443);
+	$self->port(443);
 }
 
 
@@ -135,6 +193,10 @@ sub clean_content {
 		if (!$content{'first_name'} || !$content{'last_name'} && $content{'name'}) {
 		    ($content{'first_name'}, $content{'last_name'}) = split(' ', $content{'name'}, 2);
 		}
+		
+		if ($content{'address'} =~ m/[\D ]*(\d+)\D/) {
+			$content{'street_number'} = $1;
+		}
 	}
 	warn "Content after cleaning:\n".Dumper(\%content)."\n" if ($DEBUG >2);
 	$self->content(%content);
@@ -195,7 +257,7 @@ sub submit {
 			first_name		=> ($content{'first_name'}) ? $content{'first_name'} : '',
 			last_name		=> ($content{'last_name'}) ? $content{'last_name'} : '',
 			postal_code		=> ($content{'zip'}) ? $content{'zip'} : '',
-			street_address	=> ($content{'address'}) ? $content{'address'} : '',
+			street_address	=> ($content{'street_number'}) ? $content{'street_number'} : '',
 			industry_type	=> ($content{'IndustryInfo'} && lc($content{'IndustryInfo'}) eq 'ecommerce') ? 'ecom_3' : '',
 			invoice_num		=> ($content{'invoice_number'}) ? $content{'invoice_number'} : '',
 			appid			=> $self->appid(),
@@ -263,11 +325,17 @@ sub submit {
 	my $xml_data;
     $tt->process( \$xml_template, $template_vars, \$xml_data ) || croak $tt->error();
 	
-    44rewdwarn "XML:\n$xml_data\n" if $DEBUG > 2;
+    warn "XML:\n$xml_data\n" if $DEBUG > 2;
     
-    my $opts = {'headers' => {}, 'Content-Type' => 'multipart/form-data'};
+#     my $opts = {'Content-Type' => 'multipart/form-data'};
+    my $opts = {'Cache-Control' => 'no-cache', 'Content-Type' => 'multipart/form-data; boundary=----FormBoundaryE19zNvXGzXaLvS5C'};
     my $params = {param => $xml_data};
-	my ( $page, $server_response, %headers ) = $self->https_post( $opts, $params );
+    my $content = qq|----FormBoundaryE19zNvXGzXaLvS5C
+Content-Disposition: form-data; name="param"
+
+${xml_data}
+----FormBoundaryE19zNvXGzXaLvS5C|;
+	my ( $page, $server_response, %headers ) = $self->https_post( $opts, $content );
   
     # store the server response.
     $self->server_response($server_response);
@@ -328,7 +396,7 @@ sub _get_xml_template {
 	my $xml_template = q|<Request >
     <MerchantData> 
 		<Platform>[% auth.platform %]</Platform>
-		<UserID>[% auth.userid %]</UserId> 
+		<UserId>[% auth.userid %]</UserId> 
 		<GID>[% auth.gid %]</GID>
 		<Tid>[% auth.tid %]</Tid>
 	</MerchantData>
@@ -358,7 +426,8 @@ sub _get_xml_template {
 		$xml_template .= _get_xml_template_update_token();
 	}
 	
-	$xml_template .= "\n</Request>";
+	$xml_template .= "</Request>";
+	$xml_template =~ s/[\n\t\s]*//g;
 	
 	return $xml_template;
 }
@@ -386,32 +455,34 @@ sub _get_xml_template_charge {
 		</IndustryType>
 		<ApplicationId>[% payment.appid %]</ApplicationId>
 		<Recurring>[% payment.recurring %]</Recurring>
-	</ProcessPayment>
-	<Level2PurchaseInfo>
-		<Level2CardType>[% level2.card_type %]</Level2CardType >
-		<PurchaseCode>[% level2.purchase_code %]</PurchaseCode>
-		<ShipToCountryCode>[% level2.country_code %]</ShipToCountryCode>
-		<ShipToPostalCode>[% level2.ship_tp_postal_code %]</ShipToPostalCode>
-		<ShipFromPostalCode>[% level2.ship_from_postal_code %]</ShipFromPostalCode>
-		<SalesTax>[% level2.sales_tax %]</SalesTax>
-		<ProductDescription1>[% level2.product_description1 %]</ProductDescription1>
-		<ProductDescription2>[% level2.product_description2 %]</ProductDescription2>
-		<ProductDescription3>[% level2.product_description3 %]</ProductDescription3>
-		<ProductDescription4>[% level2.product_description4 %]</ProductDescription4>
-	</Level2PurchaseInfo>
-	<Level3PurchaseInfo>
-		<PurchaseOrderNumber>[% level3.purchase_order_num %]</PurchaseOrderNumber>
-		<OrderDate>[% level3.order_date %]</OrderDate>
-		<DutyAmount>[% level3.duty_amount %]</DutyAmount>
-		<AlternateTaxAmount>[% level3.alt_tax_amount %]</AlternateTaxAmount>
-		<DiscountAmount>[% level3.discount_amount %]</DiscountAmount>
-		<FreightAmount>[% level3.freight_amount %]</FreightAmount>
-		<TaxExemptFlag>[% level3.tax_exempt %]</TaxExemptFlag>
-		<LineItemCount>[% level3.line_item_count %]</LineItemCount>
-		<PurchaseItems>
-			[% level3.purchase_items %]
-		</PurchaseItems>
-	</Level3PurchaseInfo>|;
+	</ProcessPayment>|;
+	
+	# other options (that we are not using right now):	
+# 	<Level2PurchaseInfo>
+# 		<Level2CardType>[% level2.card_type %]</Level2CardType >
+# 		<PurchaseCode>[% level2.purchase_code %]</PurchaseCode>
+# 		<ShipToCountryCode>[% level2.country_code %]</ShipToCountryCode>
+# 		<ShipToPostalCode>[% level2.ship_tp_postal_code %]</ShipToPostalCode>
+# 		<ShipFromPostalCode>[% level2.ship_from_postal_code %]</ShipFromPostalCode>
+# 		<SalesTax>[% level2.sales_tax %]</SalesTax>
+# 		<ProductDescription1>[% level2.product_description1 %]</ProductDescription1>
+# 		<ProductDescription2>[% level2.product_description2 %]</ProductDescription2>
+# 		<ProductDescription3>[% level2.product_description3 %]</ProductDescription3>
+# 		<ProductDescription4>[% level2.product_description4 %]</ProductDescription4>
+# 	</Level2PurchaseInfo>
+# 	<Level3PurchaseInfo>
+# 		<PurchaseOrderNumber>[% level3.purchase_order_num %]</PurchaseOrderNumber>
+# 		<OrderDate>[% level3.order_date %]</OrderDate>
+# 		<DutyAmount>[% level3.duty_amount %]</DutyAmount>
+# 		<AlternateTaxAmount>[% level3.alt_tax_amount %]</AlternateTaxAmount>
+# 		<DiscountAmount>[% level3.discount_amount %]</DiscountAmount>
+# 		<FreightAmount>[% level3.freight_amount %]</FreightAmount>
+# 		<TaxExemptFlag>[% level3.tax_exempt %]</TaxExemptFlag>
+# 		<LineItemCount>[% level3.line_item_count %]</LineItemCount>
+# 		<PurchaseItems>
+# 			[% level3.purchase_items %]
+# 		</PurchaseItems>
+# 	</Level3PurchaseInfo>
 
 	return $xml_template;
 }
@@ -452,7 +523,7 @@ sub _get_xml_template_void {
         <AccountNumber>[% payment.account_number %]</AccountNumber>
         <ExpirationMonth>[% payment.exp_month %]</ExpirationMonth>
         <ExpirationYear>[% payment.exp_year %]</ExpirationYear>
-        <ReferenceNumber>[% payment.ref_num %]</ReferenceNumber>
+        <ReferenceNumber>[% payment.reference_number %]</ReferenceNumber>
         <TransactionDate/>
         <IndustryType1>[% payment.industry_type %]</IndustryType1>
         <ApplicationId>[% payment.appid %]</ApplicationId>