Perl Newbie Needs Help ASAP!

C

ctrl+alt+delete

I am trying to help a friend modify the following web form action page to
utilize some URL parameters passed back using an image pipe from an email
and neither of us have experience coding in Perl. Can someone please help
me?

Here are the URL params that will be passed back by the image pipe:

This part I am fine with

<img
src="https://lnk.nxr1.com/et?id=1852&em=EMAIL&t_od=UNIQUE_ID&t_to=1.00&t_it=POW">



This is where I need help:



The query string variables are:



em = Email of the user

t_od = Unique order id (your internal id)

t_to = 1.00

t_it = POW





Here is the Perl code from the action page:



#!/usr/bin/perl



BEGIN

{

push @INC, "/usr/local/******/utility/perl-lib";

push @INC, "/usr/local/******/billing/perl-lib";

#$ENV{DEBUG} = 0;

};





use CGI;

use DBI;

use util;

use cc;

require "billNenrol_core.pl";

require "csi_lib.pl";

require "ahalib.pl";

### Package Module Includes

use LWP::protocol::https;

use LWP::UserAgent;

use HTTP::Request;

use HTTP::Response;

use URI;

use Math::BigInt;



#$|=1;

print "Content-type: text/html\n\n";



local $dbh=dbhconnect();

if (!$dbh )

{

# Failure call handled by &dbhconnect

print "No DB connection<br>\n";

exit;

}

local %query = &GetQuery();



foreach $key(keys %query)

{

#$ENV{DEBUG} && print "$key = $query{$key}<br>\n";

}

#*******************************************

if ($query{'next'} eq "new")

{

if ($query{email})

{

$ins = "insert into pmg_campaign_stats ".

"(first_name,email_address,opt_in_date,acct_code,oto_page_visit,free_download_page_visit,kiosk_page_visit)
".

"values('$query{first_name}','$query{email}',sysdate,'$query{acct_code}',1,1,1)";

##$ENV{DEBUG} & print "ins = $ins<br>";

$sth = $dbh->prepare($ins);

$sth->execute();

$sth->finish();

$dbh->commit;



&send_remodel_email();

}



$query{'offer_amount'} = &offer_amount();

my $template;

if ($query{'offer_amount'} == 197)

{

$template =
"/var/www/https-********************/docs/remodel/po.html";

}

else

{

$template =
"/var/www/https-********************/docs/remodel/po.html";

}



open(templatefile,$template) || die "Can't open $template\n";

while (<templatefile>)

{

s/\[ACCT_CODE\]/$query{acct_code}/g;

s/\[FNAME\]/$query{first_name}/g;

s/\[EMAIL\]/$query{email}/g;

print $_;

}



close(templatefile);

}

elsif ($query{'next'} eq "kiosk")

{

$query{'test_offer'} = $query{'acct_code'};



if ($query{'part_code'} eq 'OPTI')

{

if ($query{'test_offer'} == 1) { $query{acct_code} =
'1O001'; }

elsif ($query{'test_offer'} == 2) {
$query{acct_code} = '1O002'; }

elsif ($query{'test_offer'} == 3) {
$query{acct_code} = '1O003'; }

elsif ($query{'test_offer'} == 4) {
$query{acct_code} = '1O004'; }

else { $query{acct_code} = '1O001'; }

}

elsif ($query{'part_code'} eq 'CINT')

{

if ($query{'test_offer'} == 1) { $query{acct_code} =
'1C001'; }

elsif ($query{'test_offer'} == 2) {
$query{acct_code} = '1C002'; }

elsif ($query{'test_offer'} == 3) {
$query{acct_code} = '1C003'; }

elsif ($query{'test_offer'} == 4) {
$query{acct_code} = '1C004'; }

else { $query{acct_code} = '1C001'; }

}

elsif ($query{'part_code'} eq 'ARG')

{

if ($query{'test_offer'} == 1) { $query{acct_code} =
'1A001'; }

elsif ($query{'test_offer'} == 2) {
$query{acct_code} = '1A002'; }

elsif ($query{'test_offer'} == 3) {
$query{acct_code} = '1A003'; }

elsif ($query{'test_offer'} == 4) {
$query{acct_code} = '1A004'; }

else { $query{acct_code} = '1A001'; }

}

elsif ($query{'part_code'} eq 'FCLX')

{

if ($query{'test_offer'} == 1) { $query{acct_code} =
'1F001'; }

elsif ($query{'test_offer'} == 2) {
$query{acct_code} = '1F002'; }

elsif ($query{'test_offer'} == 3) {
$query{acct_code} = '1F003'; }

elsif ($query{'test_offer'} == 4) {
$query{acct_code} = '1F004'; }

else { $query{acct_code} = '1F001'; }

}

elsif ($query{'part_code'} eq 'RSM')

{

if ($query{'test_offer'} == 1) { $query{acct_code} =
'1S001'; }

elsif ($query{'test_offer'} == 2) {
$query{acct_code} = '1S002'; }

elsif ($query{'test_offer'} == 3) {
$query{acct_code} = '1S003'; }

elsif ($query{'test_offer'} == 4) {
$query{acct_code} = '1S004'; }

else { $query{acct_code} = '1S001'; }

}

else

{

$query{acct_code} = '1P046';

}

$ins = "insert into pmg_campaign_stats ".

"(first_name,email_address,opt_in_date,acct_code,oto_page_visit,free_download_page_visit,kiosk_page_visit)
".

"values('$query{first_name}','$query{email}',sysdate,'$query{acct_code}',1,1,1)";

#print "ins = $ins<br>";

$sth = $dbh->prepare($ins);

$sth->execute();

$sth->finish();

$dbh->commit;





#$query{'offer_amount'} = &offer_amount();

#my $template;

#if ($query{'offer_amount'} == 197)

#{

if ($query{'test_offer'} == 1) { $template =
"/var/www/https-********************/docs/remodel/po1.html"; }

elsif ($query{'test_offer'} == 2) { $template =
"/var/www/https-********************/docs/remodel/po2.html"; }

elsif ($query{'test_offer'} == 3) { $template =
"/var/www/https-********************/docs/remodel/po3.html"; }

elsif ($query{'test_offer'} == 4) { $template =
"/var/www/https-********************/docs/remodel/po4.html"; }

else { $template =
"/var/www/https-********************/docs/remodel/po1.html"; }

#}

#else

#{

#$template =
"/var/www/https-********************/docs/remodel/po1.html";

#}



open(templatefile,$template) || die "Can't open $template\n";

while (<templatefile>)

{

s/\[ACCT_CODE\]/$query{acct_code}/g;

s/\[FNAME\]/$query{first_name}/g;

s/\[EMAIL\]/$query{email}/g;

print $_;

}



close(templatefile);

}

elsif ($query{'next'} eq "charge")

{

&charge();

}

$dbh->disconnect;

exit;

#*******************************************

sub charge

{

$query{'first_name'} = $query{'card_fname'};

$query{'last_name'} = $query{'card_lname'};

$query{'zip'} = $query{'card_zip'};



$query{'first_name'} = lc $query{'first_name'};

$query{'last_name'} = lc $query{'last_name'};

$query{'email'} =~ tr /A-Z/a-z/;

$query{'email'} = lc $query{'email'};



$query{'member_class'} = '100000';

if ($query{'card_cvv'}) { $query{'cvv_used'} = "Y"; }



my $check = "select count(*) from customer ".

"where
lower(email_address)='$query{email}' ".

"and lower(first_name_list)
= '$query{first_name}' ".

"and lower(last_name_list) =
'$query{last_name}' ".

"and brand_id='01'";

my $chk_sth=$dbh->prepare($check);

$chk_sth->execute();

my $chk_count = $chk_sth->fetchrow();

$chk_sth->finish();

##$ENV{DEBUG} && print "check = $check <br>check =
$chk_count<br>";



if ($chk_count > 0)

{

print "<div align=\"center\"><font
color=red><b>Customer already exists</b></font><br>";

$dbh->disconnect;

exit;

}



($query{'city'},$query{'state'})=getCityState($query{'zip'});

if (!$query{'city'})

{

print "<div align=\"center\"><font color=red><b>City
not found</b></font><br>";

print "<b><a href=\"#\"
onClick=\"history.go(-1)\">Go Back</a></b><br></div>";

exit;

}

if (!$query{'state'})

{

print "<div align=\"center\"><font
color=red><b>State not found</b></font><br>";

print "<b><a href=\"#\"
onClick=\"history.go(-1)\">Go Back</a></b><br></div>";

exit;

}

$query{'card_city'} = $query{'city'};

$query{'card_state'} = $query{'state'};

#test member

if ($query{'card_number'} =~ /^41111/)

{

$sel_seq = "select member#_test_seq.nextval from
dual";

}

else

{

$sel_seq = "select member#_seq.nextval from dual";

}

$seq_sth = $dbh->prepare($sel_seq);

$r_code = $seq_sth->execute;

if (! defined $r_code)

{

##$ENV{DEBUG} && print "execute failed on
$seq_sth<br>\n";

$seq_sth->finish;

}

$query{'member#'} = $seq_sth->fetchrow();

$seq_sth->finish;

##$ENV{DEBUG} && print "member# = $query{'member#'}<Br>";



$query{'first_name'} = ucfirst lc $query{'first_name'};

$query{'last_name'} = ucfirst lc $query{'last_name'};



($query{vendor_id},$query{tier},$query{brand_id},$grace_period)
= &get_camp_info($query{acct_code});

##$ENV{DEBUG} && print "get_camp_info returned
$query{vendor_id},$query{tier},$query{brand_id},$grace_period<br>\n";

# Process the customer Record and all billing Invoices

##$ENV{DEBUG} && print "calling
<strong>proc_charge</strong><br>";

($ret_str,$ret_status,$ref) = &proc_charge(\%query);

#print "<BR>proc_charge returned $ret_str,$ret_status <br>\n";

if ($ret_status != 0)

{

##$ENV{DEBUG} && print "proc_charge failed, returned
$ret_status";

print "<br><br><div align=\"center\"><font
color=\"Red\"><strong>Billing Error!</strong></font><Br>";

print "<b><a href=\"#\"
onClick=\"history.go(-1)\">Go Back</a></b><br></div>";

exit;

}

else

{

#system("/usr/local/******/tools/mult_prt_welcome.pl
-l 10 welcome_01_29 $query{'member#'} &");

#autoresponder email

#undef %aec;

#$aec{'first_name'} = $query{'first_name'};

#$aec{'email'} = $query{'email'};

#$aec{'extra_ar'} = "";

#$aec{'id'} = 3;

#$aec{'subscription_type'} = "E";

#$url =
"http://www.*****.com/cgi-bin/arp3/arp3-formcapture.pl";

#while ( ($key, $value) = each(%aec) )
{$aec_post=$aec_post."$key=$value\&";}



#$ua = LWP::UserAgent->new;

#my $req = HTTP::Request->new(POST => $url);

#$req->content_type('application/x-www-form-urlencoded');

#$req->content($aec_post);

#my $res = $ua->request($req);



$upd = "update pmg_campaign_stats ".

"set
paid_download_page_visit=1,first_name='$query{first_name}',last_name='$query{last_name}'
".

"where email_address = '$query{email}'";

##$ENV{DEBUG} & print "upd = $upd<br>";

$sth = $dbh->prepare($upd);

$sth->execute();

$sth->finish();

$dbh->commit;



#relocate

$mem = $query{'member#'};

print <<EOF;

<head>

<title>******</title>

<META http-equiv="Refresh"
content="0;URL=http://www.*****.com/newmembera.cfm?mbrno=$mem">

</head>

EOF

}

}

#*******************************************************************

sub proc_charge

{

my $ref=$_[0];

foreach $key(keys %$ref)

{

##$ENV{DEBUG} && print "<br>$key...ref...$$ref{$key}<br>\n";

}



$member_id = $$ref{'member#'};

my ($err_str,$rCode,$db_amount,$t_amount,$success);



#$ENV{DEBUG} && print "<BR>Start processBilling, Input parameter
= $member_id,$$ref{'acct_code'} \n";

my $cred_check;

my $cc_obj = new cc;

if (! defined $cc_obj )

{

$err_str .= "Unable to create creditcard object | ";

print "<br><br><div align=\"center\"><font
color=\"#FF0000\"><strong>Error!</strong></font></div><br>";

return ($err_str,1,$ref);

}



#get order number to process it for CC

$$ref{'orderNum'} = get_order_number();

if (!defined $$ref{'orderNum'})

{

$err_str .= "get_order_number failed, returned
$ordernum | ";

print "<br><br><div align=\"center\"><font
color=\"#FF0000\"><strong>Error!</strong></font></div><br>";

return ($err_str,1,$ref);

}

$$ref{'customerNum'}= $$ref{'member#'};

###########################################################

### Checks if the credit card has anough credit for ###

### initial_fee and balance_due in a total ###

###########################################################

my ($check,$tAmount,$ini_fee);

#$ENV{DEBUG} && print "<b>acct_Code= $$ref{'original_source'} =
$$ref{'acct_code'}</b><br>";

$$ref{'original_source'} = $$ref{'acct_code'};

($check,$tAmount,$ini_fee,$$ref{act_fee},$$ref{b_rate_id}) =
&check_credit($$ref{'original_source'});

#$ENV{DEBUG} && print "check_credit returned
$check,$tAmount,$ini_fee\n";

$t_amount=$tAmount;

if ((!$check ) or (!$tAmount) or (!$ini_fee))

{

$err_str .= "check_credit failed, returned
$check,$tAmount,$ini_fee | ";

print "<br><br><div align=\"center\"><font
color=\"#FF0000\"><strong>Error!</strong></font></div><br>";

return ($err_str,1,$ref);

}

$db_amount=$ini_fee;

$$ref{'card_amount'}=$db_amount;

$t_amount=$ini_fee;



### Format initial fee:

$t_amount=amount_format($t_amount);

if (! $t_amount)

{

$err_str .= " amount_format failed, returned
$t_amount | ";

print "<br><br><div align=\"center\"><font
color=\"#FF0000\"><strong>Error!</strong></font></div><br>";

return ($err_str,1,$ref);

}

$$ref{'card_amount'}=$t_amount;



#Time to format hashes based on given values

my %input1 = &format_hashes(%$ref);

if (!defined %input1)

{

$err_str .= " format_hashes failed | ";

print "<br><br><div align=\"center\"><font
color=\"#FF0000\"><strong>Error!</strong></font></div><br>";

return ($err_str,1,$ref);

}



$input1{member_id}=$member_id;

foreach my $key(keys %input1)

{

#$ENV{DEBUG} && print "$key =input1=
$input1{$key}<br>\n";

}



# Proceed with transaction

if($$ref{vendor_id} =~ /^IPS|^ICS/ && $check=~/N/i)

{

$success =
$cc_obj->submit($$ref{vendor_id},'U',%input1);

$rCode = $cc::statusno;

my %hashcc = $cc_obj->hashStructure();

#$ENV{DEBUG} && print
"cvv....$hashcc{CVV_RESPONSE}....$hashcc{'AVS Response Code'}**** rCode =
<b>$rCode</b><br>\n";



if (($input1{'account'} =~ /^3/) &&
(!$hashcc{CVV_RESPONSE}))

{

$hashcc{CVV_RESPONSE} = "M";

}

if($rCode eq "00")

{

#unless($hashcc{'AVS Response Code'} =~
/N|D|G|I|M|P/)

#{

if($$ref{'card_cvv'})

{

if($hashcc{CVV_RESPONSE}
=~ /M|P/)

{

#$ENV{DEBUG}
&& print "<b>card_cvv</b> auth successfull, sending for capture<br>\n";

my
%auth_hash;

if($$ref{vendor_id}
=~ /ICS/){


$auth_hash{amount}=$input1{amount};


$auth_hash{firstname}=$$ref{'first_name'};


$auth_hash{lastname}=$$ref{'last_name'};


$auth_hash{account}=$$ref{'card_number'};


$auth_hash{trackingid}=$hashcc{'Unique Reference Number'};


$auth_hash{batchid}=$hashcc{'batchid'};


$auth_hash{authcode}=$hashcc{'Authorization Response Code'};

}

else
{


$auth_hash{AMOUNT}=$input1{AMOUNT};


$auth_hash{TRANSACTION_ID}=$hashcc{'Unique Reference Number'};

}

$auth_hash{member_id}=$member_id;

foreach
my $auth(keys %auth_hash) {


#$ENV{DEBUG} && print "$auth...$auth_hash{$auth}<br>\n";

}

$success
= $cc_obj->submit($$ref{vendor_id},'X',%auth_hash);

$rCode
= $cc::statusno;

}

else

{

$rCode
= "N7";

#$ENV{DEBUG}
&& print "Auth failed, no capture<br>\n";

}

}

else

{

#$ENV{DEBUG} &&
print "auth successfull, sending for capture<br>\n";

my %auth_hash;

if($$ref{vendor_id}
=~ /ICS/){

$auth_hash{amount}=$input1{amount};

$auth_hash{firstname}=$input1{'firstname'};

$auth_hash{lastname}=$input1{'lastname'};

$auth_hash{account}=$input1{'account'};

$auth_hash{trackingid}=$hashcc{'Unique
Reference Number'};

$auth_hash{batchid}=$hashcc{'batchid'};

$auth_hash{authcode}=$hashcc{'Authorization
Response Code'};

}

else {

$auth_hash{AMOUNT}=$input1{AMOUNT};

$auth_hash{TRANSACTION_ID}=$hashcc{'Unique
Reference Number'};

}

$auth_hash{member_id}=$member_id;

foreach my
$auth(keys %auth_hash) {

#$ENV{DEBUG}
&& print "$auth...$auth_hash{$auth}<br>\n";

}

$success =
$cc_obj->submit($$ref{vendor_id},'X',%auth_hash);

$rCode =
$cc::statusno;

}

#}

#else

#{

#$err_str="AVS MISMATCH";

#return("AVS
MISMATCH",1,$ref);

#}

}

}

else

{

$success =
$cc_obj->submit($$ref{vendor_id},$check,%input1);

$rCode = $cc::statusno;

}



#$ENV{DEBUG} && print "<BR>cc_obj->submit returned $success \n";

if($success =~ /VENDOR CONNECTION FAILED/)

{

print OUT "CC VENDOR CONNECTION FAILED\n";

$$ref{dpi_ret_code} = "FC";

print "<br><br><div align=\"center\"><font
color=\"#FF0000\"><strong>Error!</strong></font></div><br>";

return ("CC VENDOR CONNECTION FAILED",1,$ref);

}

#$rCode='2010';



if(!defined $rCode) { $rCode="NU"; }

$$ref{dpi_ret_code} = $rCode;

my %hashcc = $cc_obj->hashStructure();

my $ref_resp=\%hashcc;

$$ref_resp{cc_num}=$$ref{card_number};

if(!$$ref_resp{'Transaction ID'} && $$ref{vendor_id} =~ /ICS/) {

$$ref_resp{'Transaction ID'}=$hashcc{Batch_id};

}



ins2cc_resp($ref_resp,$member_id,$$ref{vendor_id},$check);

$dbh->commit;

#$ENV{DEBUG} && print "<BR>cc::statusno returned
++++$rCode++++<br>\n";



# Get the return code number

if (! defined $success)

{

$err_str .= "CC VENDOR submit failed, returned
$success | ";

print "<br><br><div align=\"center\"><font
color=\"#FF0000\"><strong>Error!</strong></font></div><br>";

return ($err_str,1,$ref);

}



foreach my $k (keys %hashcc)

{

#$ENV{DEBUG} && print "hashcc: $k =
$hashcc{$k}<br>\n";

}



# Get the return code type from vendor_return_codes table

my $code_type=get_transaction_code($$ref{vendor_id},$rCode);

#$ENV{DEBUG} && print "<BR>get_transaction_code returned
$code_type \n";

$code_type=~ s/ //g;



if ($code_type eq "1")

{

$err_str .= " get_transaction_code, returned
$code_type | ";

return ($err_str,1,$ref);

}



#in case of credit card was not approval

if(!$hashcc{'Unique Reference Number'})

{ $hashcc{'Unique Reference Number'} = 99999999; }



if($rCode ne "00" )

{

#$ENV{DEBUG} && print "<font
color=\"#FF0000\">rCode=$rCode</font><br>";

#&display_decline($cc_obj);

$err_str .= "CC VENDOR failed, returned $rCode | ";

return ($err_str,1,$ref);

}



my $uRefNum = $hashcc{'Unique Reference Number'};

if($$ref{vendor_id} =~ /ICS/){ $hashcc{'Transaction ID'} =
$hashcc{'Batch_id'}; }

if(!$hashcc{'Transaction ID'}) { $hashcc{'Transaction
ID'}=$uRefNum; }

my $tranID = $hashcc{'Transaction ID'};

my $authCode = $hashcc{'Authorization Response Code'};

$DATA{'uRefNum'}=$uRefNum;



#################################################################

###
###

### If credit card was billed for the new membership rate
###

###
###

#################################################################



# Create the newmember hash to be sent to the database

my %formparams;

%formparams = create_new_member_hash(%$ref);

if($$ref{tier}) { $formparams{tier} = $$ref{tier}; }

if (! %formparams)

{

$err_str .= " create_new_member_hash failed | ";

}



$$ref{'uRefNum'}=$uRefNum;

$$ref{'tranID'}=$tranID;

if(!$authCode) {$authCode=$uRefNum;}

$$ref{'authCode'} = $authCode;

$$ref{'returnCode'}=$rCode;

$formparams{original_source} = "'$$ref{original_source}'";

$formparams{on_line_user}="'Y'";

$formparams{original_member_type}="'CC'";

if($$ref{'card_cvv'}){ $formparams{cvv_used}="'Y'"; }



my $grp_code="select group_code from tiers where ".

"tier_brand='$$ref{brand_id}'
and tier_num=$$ref{tier}";

my $grp_sth=$dbh->prepare($grp_code);

$grp_sth->execute;

$formparams{group_code}=$grp_sth->fetchrow;



my $g_flag;

if($query{kit_enrol}) {

$g_flag="KIT";

}

else { $g_flag="C"; }



#$ENV{DEBUG} && print "<b>before add_new_member</b><br>";

($ret_srt,$ret_status) =
&add_new_member($db_amount,$g_flag,$uRefNum,$tranID,$authCode,$$ref{vendor_id},$check,\%formparams);



if($ret_status != 0)

{

$err_str .= $ret_str . " add_new_member_this
returned $ret_status | ";

my $yr="%Y";

my $hr="%H";

my $mi="%M";

my $dttime=`date +${yr}%m%d${hr}${mi}%S`;

chomp $dttime;

print "$dttime|";

foreach my $key(keys %query)

{

if($query{$key})

{

unless ($key =~
/termstext|mem_number|whattodo|testtodo/)

{

print
"$key=$query{$key}|";

}

}

}

#print "<br><br><div align=\"center\"><font
color=\"#FF0000\"><strong>Error!</strong></font></div><br>";

return ($err_str,1,$ref);

}

#$ENV{DEBUG} && print "<BR>End processBilling \n";

return ($err_str,0,$ref);

}

#********************************************88

sub send_remodel_email

{

undef %aec;

$aec{'first_name'} = $query{'first_name'};

$aec{'email'} = $query{'email'};

$aec{'extra_ar'} = "";

$aec{'subscription_type'} = "E";

$url =
"http://www.***********.com/cgi-bin/arp3/arp3-formcapture.pl";



#$query{'offer_amount'} = &offer_amount();

#if ($query{'offer_amount'} == 1)

#{

$aec{'id'} = 7;

#}

#else

#{

#$aec{'id'} = 2;

#}



while ( ($key, $value) = each(%aec) )
{$aec_post=$aec_post."$key=$value\&";}



$ua = LWP::UserAgent->new;

my $req = HTTP::Request->new(POST => $url);

$req->content_type('application/x-www-form-urlencoded');

$req->content($aec_post);

my $res = $ua->request($req);



#foreach $key(keys %$res)

# {

# #$ENV{DEBUG} && print
"<br>$key...CSI...$$res{$key}<br>\n";

#print "$key=$$res{$key}|";

# }

}

#**************************** offer_amount ********************

sub offer_amount

{

$sel = "select MEMBER_INSTALL_FEE ".

"from billing_rate a, campaign_efforts b ".

"where original_source='$query{acct_code}' ".

"and a.billing_rate_id = b.billing_rate_id";

$sth = $dbh->prepare($sel);

$sth->execute();

$offer_amount = $sth->fetchrow();

$sth->finish;

return $offer_amount;

}
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

Forum statistics

Threads
473,744
Messages
2,569,483
Members
44,901
Latest member
Noble71S45

Latest Threads

Top