The Web Design Group

... Making the Web accessible to all.

Welcome Guest ( Log In | Register )

2 Pages V  1 2 >  
Reply to this topicStart new topic
> HTML and Perl CGI, HTML and Perl CGI
citabriabob
post Jul 27 2020, 04:32 PM
Post #1


Newbie
*

Group: Members
Posts: 10
Joined: 27-July 20
Member No.: 27,457



I have html <form method="post" action="cgi-bin/order.cgi"> where inputs are <input autocomplete="off" type="text" size="1" maxlength="2" name="MI-527" value="">.
cgi script is perl. Random orders come in with unspecified inputs and all are very high quantities. I wrote this off as a chrome problem, but need to fix regardless. Thanks,
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
pandy
post Jul 27 2020, 04:38 PM
Post #2


Computer says no.
********

Group: WDG Moderators
Posts: 19,222
Joined: 9-August 06
Member No.: 6



You need to show a little, or rather a lot, more if someone is going to be able to help you.
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
citabriabob
post Jul 27 2020, 04:51 PM
Post #3


Newbie
*

Group: Members
Posts: 10
Joined: 27-July 20
Member No.: 27,457



This is the output of the Perl script. Only the last item was actually ordered; he rest are phantoms. All items come from the html as mentioned.


Your order was received; please let us know immediately if there are
any errors. Otherwise, we thank you for supporting the Club and we
will ship as follows:


To: Name / address


Email: cxxxx@yyyyyy.com
Member ID: 7393

Credit card ending with: 3853

----------------------------------------------------------------------
Qty Item Description Price Total
----------------------------------------------------------------------
28 MI-531K [Khaki] $15.95 $446.60
28 MI-531N [Navy] $15.95 $446.60
28 MI-531S [Stone] $15.95 $446.60
28 MI-531T [Taupe] $15.95 $446.60
28 MI-541N [Navy] $15.95 $446.60
28 MI-541S [Stone] $15.95 $446.60
28 MI-561K [Khaki] $15.95 $446.60
28 MI-561N C [Navy] $15.95 $446.60
28 MI-561S [Stone] $15.95 $446.60
28 MI-561T [Taupe] $15.95 $446.60
1 MI-970 Actual Item $99.95 $99.95
----------------------------------------------------------------------
Subtotal: $4565.95

Shipping: $18.00
----------------------------------------------------------------------
Total: $4583.95


This is the Perl code. it's been working weel for years except the occasional problem above

#!/usr/bin/perl
# order.cgi

#use DLSTools;
use CGI::Carp qw(fatalsToBrowser);
use strict;
use warnings;


#
# Variables and configuration
#

# Who.
my $salesman = 'orders@xxx.com';

my $make_receipt_contact_email = $salesman;

# What. Database file
my $pricelist = "prices.dat";

# Where.
my $homepage = "http://www.bellanca-championclub.com/";

# Why. Optional, used in all calls to print_errors().
my $print_errors_title = 'Order form error';

# Map field names to human-friendly titles.
my %form_field_title = (
# quotes, else leading zeros mean octal notation
'01last' => 'Last name',
'02first' => 'First name',
'03address1' => 'Address 1',
'04address2' => 'Address 2',
'05city' => 'City',
'06state' => 'State',
'07zip' => 'ZIP/P.C.',
'08country' => 'Country',
'09member' => 'Member ID',
'51CardNum' => 'Card num',
'57CardExpMonth' => 'Expiration month',
'58CardExpYear' => 'Expiration year',
'17email' => 'Email',
'21emailconfirm' => 'Email confirm',
'18tax' => 'Tax county',
'19comments1' => 'Comments 1',
'20comments2' => 'Comments 2',
'home_tel' => 'Home Telephone',
'bus_tel' => 'Business Telephone',
'32personalization' => 'Personalization',
);
# Items returned from the HTML form by item ID => qty. eg:
# 'MI-101' => 2,
# 'MI-321M' => '',
# 'MI-321S' => 1,

# Map stash names to human-friendly titles.
my %stash_field_title = (
last => 'Last name',
first => 'First name',
address1 => 'Address 1',
address2 => 'Address 2',
city => 'City',
state => 'State',
zip => 'ZIP/P.C.',
country => 'Country',
member_id => 'Member ID',
email => 'Email',
cc_num => 'CC Num digits',
cc_type => 'CC Type',
cc_num_formatted => 'CC Num',
cc_exp_mo => 'CC Exp Mo',
cc_exp_yr => 'CC Exp Yr',
cc_num_last_four => 'CC Last 4',
cc_exp_yr_yy => 'CC Exp Year',
tax => 'Tax county',
comments1 => 'Comments 1',
comments2 => 'Comments 2',
home_tel => 'Home Telephone',
bus_tel => 'Business Telephone',
personalization => 'Personalization',
);

# Map field names between form and stash
my @fts = (
'01last' => 'last',
'02first' => 'first',
'03address1' => 'address1',
'04address2' => 'address2',
'05city' => 'city',
'06state' => 'state',
'07zip' => 'zip',
'17email' => 'email',
'18tax' => 'tax',
'19comments1' => 'comments1',
'20comments2' => 'comments2',
'home_tel' => 'home_tel',
'bus_tel' => 'bus_tel',
'32personalization' => 'personalization',
);
my %form_to_stash = @fts;
my %stash_to_form = reverse @fts;

# Fields from stash to be used in sending order to purveyor.
# See delimited_report()
my @purveyor_report_fields = qw(
last
first
member_id
personalization
);

# Regular expression for Domestic or Foreign membership dues.
my $re_signup_dues = qr/^MI-(?:DOM|FOR|M)/;
# Regular expression for items which receive free shipping.
my $re_free_shipping_items = qr/^[AB]-418$/;

my $helper = DLSTools->new(
stash => {
},
);


#
# Execution
#

my $items = load_item_data($pricelist);

if ( !process_form(scalar $helper->http_data(), my $errors=[]) )
{
$helper->print_errors($errors, $print_errors_title);
}
else
{
my $receipt = make_receipt();

mail_order($salesman, $receipt);
mail_customer($helper->{stash}->{email}, $salesman, $receipt, $homepage);

display( $receipt, $homepage );
}


#
# Functions
#


# Check form for correctness, map values into $helper->{stash}
# $ok = process_form(\%form_data, \@errors);
# FUTURE: The stash is getting used for other data, perhaps the form data
# should be moved to stash->{form}? 2016-11-01 --rodney.broom
sub process_form
{
my ($data, $errors) = @_;

my @e;
my $s = $helper->{stash};

if (sanity_checks($data, \@e))
{
# Check credit card
my $card_num = $data->{'51CardNum'};
my ($exp_mo, $exp_yr) = @{$data}{qw(57CardExpMonth 58CardExpYear)};
my $cc_info = $helper->validate_card($card_num, $exp_mo, $exp_yr, \@e);
if ($cc_info)
{
$s->{'cc_'.$_} = $cc_info->{$_} foreach keys %{$cc_info};
}

# Have they ordered anything? This will add other meta to the stash.
if ( my $ordered = order_list($data, \@e))
{
$s->{ordered} = $ordered;
}
else
{
push @e, "It appears that no items were ordered.";
}

# Foreign or domestic?
my $country = $data->{'08country'} || '';
# is country some varient of United States of America?
if (
length($country) == 0
|| $country =~ /^\s*u\.?s\.?a?/i
|| $country =~ /united\s*states/i
)
{
$s->{foreign} = 0;
$s->{domestic} = 1;
$s->{country} = '';
}
else
{
$s->{foreign} = 1;
$s->{domestic} = 0;
$s->{country} = $country;
}

# Map remaining fields into the stash
for my $sname (keys %stash_to_form)
{
$s->{$sname} ||= $data->{ $stash_to_form{$sname} };
}
# Add formatting as needed
for my $k (qw(home_tel bus_tel))
{
$s->{$k} = $helper->format_phone($s->{$k});
}

}

push @{$errors}, @e;

return @e ? 0 : 1;
}

# Basic form checks
sub sanity_checks
{
my ($data, $errors) = @_;

my @e;
my $s = $helper->{stash};


# Required fields
# my @required = qw(01last 02first 03address1 05city 06state 07zip 17email);
my @required = qw(01last 02first 03address1 05city 17email);
my @missing;
for my $f (@required)
{
# exists() to quiet warnings
if ( !(exists($data->{$f}) and length($data->{$f})) )
{
push @missing, $f;
}
}
if (@missing)
{
push @e, sprintf qq|Missing some required fields: %s|,
join(', ', map $form_field_title{$_}, @missing);
}


# Email address
if ($data->{'17email'})
{
# email addr looks good (Email::Valid)
if ( ( $data->{'17email'} =~ /.+@.+\..+/ ) )
{
# doesn't match confirmation entry
if ( $data->{'17email'} ne $data->{'21emailconfirm'} )
{
push @e, "The email address was not entered the same on both lines. Please enter the same email address twice so that we can be sure to avoid typos.";
}
}
else
{
push @e, "The email address entered does not appear to be a valid address. Please enter an address in the form \"who\@where.com\".";
}
}

# If member is populated, then validata datum
if ( exists($data->{'09member'}) && length($data->{'09member'}) )
{
# Looks good, put it in the stash
if ( $data->{'09member'} =~ /^[0-9]{1,4}$/ )
{
$s->{member_id} = $data->{'09member'};
}
else
{
push @e, "The member ID number does not seem to be entered correctly.";
}
}


# '18tax' is required if '06state' eq 'NY'
if ($data->{'06state'} =~ /NY/i)
{
# reformat for easier testing later.
$data->{'06state'} = 'NY';
if (!$data->{'18tax'})
{
push @e, "If you live in New York State, we need to know your county for sales tax purposes.";
}
}

push @{$errors}, @e;

return @e ? 0 : 1;
}

# Load item data, return hashref.
# $data = load_item_data($file_name);
# Can terminate_to_browser().
sub load_item_data
{
my $file = shift;

open( DATA, $file ) || do {
warn qq|open($file): $!|;
terminate_to_browser(qq|CGI error: Could not open item data file.|);
};
my @data = <DATA>;
close(DATA);

my %item_data;
my $sequence = 0;
foreach (@data)
{
next if /^#/;
# Remove line endings be they DOS or UNIX or Mac
s/\r//g;
s/\n//g;
# Get the fields of data from this record
my ( $item_id, $desc, $memprice, $pubprice ) = split(/::/);

$item_data{$item_id} = {
sequence => ++$sequence,
item_id => $item_id,
desc => $desc,
memprice => $memprice,
pubprice => $pubprice,
};

# Is this item "shippable"?
if ( $item_id =~ m/$re_signup_dues/ || $item_id =~ m/$re_free_shipping_items/ )
{
$item_data{$item_id}->{'shippable'} = 0;
}
else
{
$item_data{$item_id}->{'shippable'} = 1;
}

}

return \%item_data;
}

# Build list of the items ordered, with quantities and prices.
# Determine several characteristics and note them in the stash.
# Returns undef on fail, else hashref of ordered items.
# $ordered = order_list(\%form_data, \@errors);
# $ordered = {
# $item_id1 => {qty => 2, price => 9.99},
# $item_id2 => {qty => 1, price => 55 },
# }
# Adds to errors:
# * Invalid quantity requested
#
# Stash items added:
# has_membership_dues
# is_membership_renewal
# is_new_signup
# is_non_member
# These are all boolean values that are either 0 or 1 (zero or one).
sub order_list
{
my ($data, $errors) = @_;

my $s = $helper->{stash};
my (%out, @e);

# Membership dues can be selected for both renewals and new signups
$s->{'has_membership_dues'} = (
grep {/$re_signup_dues/ && $data->{$_} > 0} keys( %{$data} )
) ? 1 : 0;

# Set defaults of zero for these, then calculate which will be set to one.
for ( qw(is_membership_renewal is_new_signup is_non_member) )
{
$s->{$_} = 0;
}

# Is this a membership renewal?
if ( $s->{'member_id'} and $s->{'has_membership_dues'} )
{
$s->{'is_membership_renewal'} = 1;
}
# Is this a NEW signup?
elsif ( $s->{'has_membership_dues'} )
{
$s->{'is_new_signup'} = 1;
}
# Else, is a non-member
else
{
$s->{'is_non_member'} = 1;
}

# Members and new signups get special pricing.
my $apply_member_price = ($s->{'member_id'} or $s->{'is_new_signup'}) ? 1 : 0;


# Look for items in the form data
for my $key ( keys %{$data} )
{
if ($items->{$key})
{
my $item = $items->{$key};

if (my $qty = $data->{$key})
{
# Confirm valid HTML form usage
if ($qty =~ /\D/)
{
push @e, "Please enter only numbers for the quantity of item $item->{desc}.";
}
# All OK; add data to our list and apply any special logic.
else
{
my $price = $apply_member_price ? $item->{memprice} : $item->{pubprice};
$out{$item->{item_id}} = {qty => $qty, price => $price};

# XXX future could check $item->{qty_in_stock}, etc. 2016-01-14 --rrb

# Knit shirts - count
if ($item->{'item_id'} =~ /^MI-3/)
{
$s->{'knit_shirt_count'} += $qty;
}
}
}
}
# looks like and item_id, but isn't in database
# XXX This does happen. 2016-01-14 --rrb
elsif ($key =~ /^(?:B-|FI-|MI-|A-)/)
{
# noop at the moment
}
}

push @{$errors}, @e;
return @e ? undef : (%out ? \%out : undef);
}

# wrapper to make reading easier
sub as_dollars
{
sprintf '$%.02f', $_[0];
}

# Build and send report to purveyor as attached file.
# This works, but was ultimately rejected for a more simple format.
sub delimited_report
{
my ($to, $receipt) = @_;

my $s = $helper->{stash};
my (@header, @rowone);
my @vertical;
for my $sname (@purveyor_report_fields)
{
push @header, $stash_field_title{$sname};
# Add datum, default to empty string to quiet warnings.
push @rowone, defined($s->{$sname}) ? $s->{$sname} : '';

# "Title: Datum\n"
next if $sname =~ /comment/;
push @vertical, swrite_nl('@<<<<<<<<<<<<<<<<<<< @*', $header[-1].':', $rowone[-1]);
}

my $comments = join "\n", map {defined($s->{$_}) ? ' '.$s->{$_} : ()} qw(comments1 comments2);
push @vertical, qq|Comments:\n$comments\n| if $comments;

my @item_header = qw(Item Qty Price Sub Description);
my @item_rows;
my $item_total = 0;
for my $item_id (sort keys %{$s->{ordered}})
{
my $oi = $s->{ordered}->{$item_id};
my $subtotal = $oi->{qty}*$oi->{price};
$item_total += $subtotal;
push @item_rows, [$item_id, $oi->{qty}, $oi->{price}, $subtotal, $items->{$item_id}->{desc}];
}
push @item_rows, ['', 'Item total:', '', '', sprintf('%.02f', $item_total), ''];

# XXX This would be better/safer with CSV. (Text::CSV) 2016-01-14 --rrb
my $delim = "\t";

my $file_content = '';
$file_content .= join($delim, @header)."\n";
$file_content .= join($delim, @rowone)."\n";
$file_content .= "\n";
$file_content .= join($delim, @item_header)."\n";
for my $i (@item_rows)
{
$file_content .= join($delim, @{$i})."\n";
}

my $customer_name = join(' ', $s->{first}, $s->{last});
(my $safe_name = $customer_name) =~ s/\W//g;

my @ymd = (localtime)[5, 4, 3];
$ymd[0] += 1900; $ymd[1] += 1;
my $today = sprintf('%04u-%02u-%02u', @ymd);
my $filename = sprintf('cgi-order-%s-%s.tsv', $today, $safe_name);

my $body = sprintf(qq|Order for %s is attached.\n\n%s\n%s\n%s\n|,
$customer_name,
q|----------------------------------------------------------------------
Customer Info
----------------------------------------------------------------------
|,
join('', @vertical),
$s->{item_table}
);

$helper->send_mail_attach_file({
to => $to,
from => $to,
subject => sprintf(qq|CGI Generated Order for %s|, $customer_name),
body => $body,
file_content => $file_content,
filename => $filename,
content_type => 'text/tab-separated-values',
}) || terminate_to_browser(qq|CGI error: Order was not sent.|);
}

# Email order to the purveyor for processing.
sub mail_order
{
my $to = shift;
my $receipt = shift;

my $s = $helper->{stash};

my $subject = sprintf(qq|CGI Generated Order for %s|, join(' ', $s->{first}, $s->{last}));

# Build CSV record of the order
my (@csv_header, @csv_fields);

# Customer information
for my $sname (@purveyor_report_fields)
{
my $title = stash_field_title($sname);
push @csv_header, qq|"$title"|;
my $datum = $s->{$sname};

# Display situation in 'member_id' for new signups
if ( $sname eq 'member_id' and $s->{'is_new_signup'} )
{
$datum = 'Membership Pending';
}
# Personalization in uppercase
elsif ( $sname eq 'personalization' )
{
$datum = uc($datum);
}

push @csv_fields, csv_escape_and_quote($datum);
}

# We want a blank column, used in the office with Excel
push @csv_header, csv_escape_and_quote('');
push @csv_fields, csv_escape_and_quote('');


my @item_header;
my @item_fields;
for my $item_id (
# sort items by sequence found in item-data file
sort { $items->{$a}->{'sequence'} <=> $items->{$b}->{'sequence'} }
keys %{$items}
)
{
my $quantity = ''; # Robert wants blank, not zero.
if ( my $order_item = $s->{ordered}->{$item_id} )
{
$quantity = $order_item->{'qty'};
}
push @item_header, csv_escape_and_quote($item_id);
push @item_fields, csv_escape_and_quote($quantity);
}

push @csv_header, @item_header;
push @csv_fields, @item_fields;

# Should the CSV content include the header record?
# Set to one to turn on the header record, zero to turn off.
my $include_csv_header = 0;
my $csv_data = $include_csv_header
? join(',', @csv_header) . "\n" . join(',', @csv_fields)
: join(',', @csv_fields);

my $body = sprintf qq|%s %s Exp: %s/%s Zip: %s Total: %s\n\n%s\n%s\n\n%s\n|,
($s->{cc_type}, $s->{cc_num_formatted}, $s->{cc_exp_mo}, $s->{cc_exp_yr}),
$s->{zip}, as_dollars($s->{order_total}),
$csv_data,
$receipt;


$helper->send_mail({
to => $to,
from => $to, # XXX DLSTools can provide a default. 2016-01-14 --rrb
subject => $subject,
body => $body,
}) || terminate_to_browser(qq|CGI error: Order was not sent.|);
}
# Find a title for stash field name, failing to alternates.
sub stash_field_title
{
my $sname = shift;
$stash_field_title{$sname} || $form_field_title{ $stash_to_form{$sname} } || $sname;
}
# Format a value to be valid as a field in a CSV record.
sub csv_escape_and_quote
{
my $datum = shift;

$datum = '' unless defined($datum);
$datum =~ s/"/""/g;
qq|"$datum"|;
}


# Send email to the customer, currently only used for the receipt.
sub mail_customer
{
my ( $to, $from, $receipt, $website ) = @_;

return $helper->send_mail({
to => $to,
from => $from,
subject => "Your order on $website",
body => $receipt,
}) || terminate_to_browser(q|CGI error: Was unable to send the customer's copy of the receipt.|);

}

# Make a formatted text receipt.
sub make_receipt
{

my $s = $helper->{stash};

# Formats and strings for rendering the plain text receipt.
#

# 70 chars wide
my $row_width = 70;

# horizontal rule
my $hr = sprintf '-' x $row_width;


# Line item layout, five columns.
my $desc_fmt = sprintf '@%s...', '<' x (38 - 4);
# 3 10 38 7 8
my $item_fmt = sprintf q|@## @<<<<<<<<< %s @>>>>>> @>>>>>>>|, $desc_fmt;

# Header record, same as item with numeric changed to text
(my $head_fmt = $item_fmt) =~ s/#/>/g;

# Two inputs; one left the other right.
my $pair_fmt = sprintf(q|@%s@%s|, '<'x(15-1), '>'x($row_width-15-1));

# Entire line justified left or right, respectively
my $line_left_fmt = sprintf('@%s', '<'x($row_width-1));
my $line_right_fmt = sprintf('@%s', '>'x($row_width-1));


# Build receipt
#


#- Customer information, etc.

# NB This content is set by hand to be inside the width of $row_width
# rather than writing fancy wrapping logic for three lines.

# Template Toolkit would help. 2016-01-14 --rrb
my $disp_addr2 = $s->{address2} ? "\n $s->{address2}" : '';
# Display Member ID or member status
my $disp_member;
if ( $s->{'member_id'} )
{
$disp_member = $s->{'member_id'};
}
elsif ( $s->{'is_new_signup'} )
{
$disp_member = 'New Member';
}
else
{
$disp_member = 'Non-member';
}

my $receipt = <<CUST_INFO_BLOCK;

Please note: If you are using Chrome and autofill, you may notice unordered items with unusual quantities;
this is a Chrome issue and we will eliminate them on receipt.

Your order was received; please let us know immediately if there are
any errors. Otherwise, we thank you for supporting the Club and we
will ship as follows:


To: $s->{'first'} $s->{'last'}
$s->{'address1'}$disp_addr2
$s->{'city'}, $s->{'state'}, $s->{'zip'}
$s->{country}

Email: $s->{email}
Member ID: $disp_member

Credit card ending with: $s->{cc_num_last_four}

CUST_INFO_BLOCK


#- Financial

# Column headers
$receipt .= "$hr\n";
$receipt .= swrite_nl($head_fmt, qw(Qty Item Description Price Total));
$receipt .= "$hr\n";

my $ordered = $s->{ordered};

# Calculate base item price and write items to the receipt
#
my $cumulative; # cummulative price
my $not_shippable; # Dollar total of items which are not shippable.
for my $item_id ( sort keys %{$ordered} )
{
my $oi = $ordered->{$item_id}; # Ordered Item

if ( my $qty = $oi->{qty} ) # should always be true
{
my $item_total = $qty * $oi->{price};
$cumulative += $item_total;

# Items that are "not shippable"
if ( not $items->{$item_id}->{'shippable'} )
{
$not_shippable += $item_total;
}

my $pf = as_dollars($oi->{price});
my $itf = as_dollars($item_total);
$receipt .= swrite_nl($item_fmt, $qty, $item_id, $items->{$item_id}->{desc}, $pf, $itf);
}
}


# Personalization of knit shirts
if ( $s->{'knit_shirt_count'} and $s->{'personalization'} )
{
my $personalization_fee_per_shirt = 5.00; # Dollars
my $personalization_total = $s->{'knit_shirt_count'} * $personalization_fee_per_shirt;
$receipt .= swrite_nl($item_fmt,
$s->{'knit_shirt_count'}, '', 'Personalization (Knit Shirts Only)',
as_dollars($personalization_fee_per_shirt), as_dollars($personalization_total)
);
# Using header record format since it allows completely empty fields.
$receipt .= swrite_nl($head_fmt, '', '', qq|To read: "$s->{'personalization'}"|, '', '');

$cumulative += $personalization_total;
}


# Subtotal
$receipt .= "$hr\n";
$receipt .= swrite_nl($pair_fmt, 'Subtotal:', as_dollars($cumulative));
$receipt .= "\n";


# Calculate domestic shipping
my $shipping = 0;
if ( $s->{domestic} )
{
# Special case, this product always incurs a shipping fee. Sun Shield
if ($ordered->{'MI-970'})
{
$shipping = $ordered->{'MI-970'}->{qty} * 18;
}
else
{
# Count of all shippable items
my $count_shippable;
for my $item_id (keys %{$ordered})
{
$count_shippable += $ordered->{$item_id}->{'qty'} if $items->{$item_id}->{'shippable'};
}

$s->{'shippable_subtotal'} = ($cumulative - $not_shippable);
# Shipping is charged for orders under $200, but we only include
# tangible (shippable) items when considering free shipping.
# Items like dues can't be shipped, so are deducted.
if ( $s->{'shippable_subtotal'} > 0 && $s->{'shippable_subtotal'} < 200 )
{
# Calculate shipping fee by number of items
# 5 or more
if ($count_shippable >= 5)
{
$shipping = 14.50;
}
# 3 or 4
elsif ($count_shippable >= 3)
{
$shipping = 9.00;
}
# 2 or less, default shipping fee
else
{
$shipping = 7.50;
}
}
else
{
# noop, free
}
}

$cumulative += $shipping;

$receipt .= swrite_nl($pair_fmt, 'Shipping:', $shipping ? as_dollars($shipping) : 'Free');
}


# Total
$receipt .= "$hr\n";
$receipt .= swrite_nl($pair_fmt, 'Total:', as_dollars($cumulative));
$s->{order_total} = $cumulative;


# Special case shipping notes
if ($s->{foreign})
{
$receipt .= swrite_nl($line_right_fmt, '* plus shipping costs (added at cost)');
}
if ( $s->{domestic} && $s->{state} eq 'NY' )
{
$receipt .= swrite_nl($line_right_fmt, '* plus Sales Tax (NY only)');
}


#- Notes to and from the customer

$receipt .= qq|

Comments: $s->{comments1}
$s->{comments2}

Please note: If you are using Chrome and autofill, you may notice unordered items with unusual quantities; this is a Chrome issue and we will eliminate them on receipt.

If you have any questions or corrections, please contact us at $make_receipt_contact_email anytime,
or call 518-731-6800 (Mon-Fri 11-6 Eastern Time.)


Thanks for shopping with us!


Bellanca-Champion Club

|;

return $receipt;
}

sub display
{
my ( $receipt, $website ) = @_;
my $s = $helper->{'stash'};

my $email_bodies;
if ( $s->{'email_bodies'} )
{
$email_bodies = qq|<hr/><h2>Email Bodies:</h2><hr/>\n|;
for my $body ( @{$s->{'email_bodies'}} )
{
$email_bodies .= qq|<pre>$body</pre>\n<hr/>\n|;
}
}

print <<"ENDOFBLOCK";
Content-type: text/html

<HTML>
<HEAD>
<TITLE>Your order has been processed</TITLE>
</HEAD>
<BODY bgcolor=#FFFFFF>
<CENTER><B>Bellanca-Champion Club</B></CENTER>
<P>&nbsp;</p>
<HR width=90% />
<P>&nbsp;</p>
<PRE>
$receipt
</PRE>
<P>&nbsp;</p>
<HR width=90% />
<P>
Feel free to continue looking through the <A href="$website">Bellanca-ChampionClub.com</A> web site!
</p>
$email_bodies
</BODY>
</HTML>
ENDOFBLOCK

}

# swrite() with a newline
sub swrite_nl
{
$helper->swrite(@_) ."\n";
}

# Send a formatted message and exit.
# terminate_to_browser($string)
# terminate_to_browser(@strings)
# terminate_to_browser(\@strings)
#
# Wrapper to DLSTools::print_exceptions()
sub terminate_to_browser
{
$helper->print_exceptions(ref($_[0]) ? $_[0] : [@_]);
exit;
}




package DLSTools;

=pod

=head1 NAME

DLSTools - Collection of functionality and configuration.


=head1 SYNOPSIS

use DLSTools;
$obj = DLSTools->new(%options);
$obj->send_mail(\%args);

=cut


use POSIX 'strftime';
use strict;

=pod

=head1 VARIABLES

Package globals that I<can> be adjusted, but should probably be left as is.

=over 4

=item *

sendmail_opts

Options to pass to sendmail. Default:

Default:
$sendmail_opts =
'-O DeliveryMode=b'; # Asynchronous delivery (faster return to browser)

=back

=cut

use vars qw(
$sendmail_opts
);

$sendmail_opts =
'-O DeliveryMode=b'; # Asynchronous delivery (faster return to browser)


# XXX This value was taken from order.cgi, likely a better option available. 2016-01-07 --rrb
my $site_admin_email = 'gifts@bellanca-championclub.com';

# Default 'From' address when none is included in args.
my $email_sender = 'emailsender@bellanca-championclub.com';


=pod

=head1 METHODS


=head2 new()

Create an object instance.

$obj = Class->new(\%opt);

=head3 %opt specifically supports:

=over 4

=item *

safe_email_recip

For safe testing, makes all mail go to address given.

safe_email_recip => 'recipient@example.com'

No default.

=item *

site_admin_email

Address used in some messaging.

Default: gifts@bellanca-championclub.com


=item *

email_sender

Default 'From' address when none is included in args.

Default: 'emailsender@abellanca-championclub.com';


=item *

me

A name for the object to use when needed.

Default is the root file name of executor. eg:
That is, if $0='/path/to/script.fil', then I<me> = "script.fil".


=back


=head3 Other parameters to C<new()>.

Since there are no accessors/mutators, any other fields may be used as desired.
For instance, to stash values to carry around in a script you could:

$obj = DSLTools->new(
stash => {title => 'My Title'},
);
print $obj->{stash}->{title};

=cut

sub new
{
my $class = shift;

(my $me = $0) =~ s/.*?([^\/\\]+)$/$1/;
return bless {
site_admin_email => $site_admin_email,
email_sender => $email_sender,
me => $me,
@_
}, $class;
}

=pod

=head2 print_errors()

Send a list of messages as HTML.

$obj->print_errors(\@messages, $title);

$title is optional, defaults to 'Form Error'

=cut

sub print_errors
{
my $self = shift;
my $errors = shift;
my $title = shift || 'Form Error';

my $error_list_items
= join("\n", map sprintf(qq|<li style="font-weight: bold;">%s</li>|, $_), @{$errors});

print <<"ENDOFBLOCK";
Content-type: text/html

<HTML>
<HEAD>
<TITLE>$title</TITLE>
</HEAD>
<BODY bgcolor=#FFFFFF>

<CENTER><H1>Bellanca-Champion Club</H1></CENTER>

There appears to be a problem with the information that you entered.
<P>
<ul>
$error_list_items
</ul>
</p>

<P>
Please press the "Back" button on your web browser and make
the appropriate changes so that we can process your application.
</p>

<P>
If you continue to have problems, feel free to email $self->{site_admin_email}
for assistance.
</p>

</BODY>
</HTML>

ENDOFBLOCK
}

=pod

=head2 print_exceptions()

Send a list of messages as HTML.

$obj->print_exceptions(\@messages, $title);
# do some cleanup work...
exit();

$title is optional, defaults to 'Exception'

Note: The name is 'exceptions' to differentiate from 'errors', but this method
does not actually die(), or even exit().

=cut

sub print_exceptions
{
my $self = shift;
my $msgs = shift;
my $title = shift || 'Exception';

my $exception_list_items
= join("\n", map sprintf(qq|<li style="font-weight: bold;">%s</li>|, $_), @{$msgs});

print <<"ENDOFBLOCK";
Content-type: text/html

<HTML>
<HEAD>
<TITLE>$title</TITLE>
</HEAD>
<BODY bgcolor=#FFFFFF>

<CENTER><H1>Bellanca-Champion Club</H1></CENTER>

There appears to have been one or more exceptional conditions:
<P>
<ul>
$exception_list_items
</ul>
</p>

<P>
Please notify $self->{site_admin_email} so that this can be fixed.<br/>
Thank you.
</p>
</BODY>
</HTML>

ENDOFBLOCK
}

=pod

=head2 send_mail()

Send text email to recipient.

$obj->send_mail(\%args)

For backwards compatability, list context is also supported:

$obj->send_mail($to, $cc, $from, $subject, $body)

%args supports:
- Required:
to
subject
body
- Optional:
from # Defaults to $obj->{email_sender}
cc

Returns _send_mail()

See _envelope_headers()

Honors $helper->{'stash'}:
email_bodies_to_stash
If true, push email bodies into @{$helper->{'stash'}->{'email_bodies'}}

do_not_send_email
If true, do not actually send email.


=cut

sub send_mail
{
my $self = shift;
my $param;

if (ref $_[0])
{
$param = shift;
}
else
{
@{$param}{qw(to cc from subject body)} = @_;
}

if ( $helper->{'stash'}->{'email_bodies_to_stash'} )
{
push @{$helper->{'stash'}->{'email_bodies'}}, $param->{'body'};
}
return 1 if $helper->{'stash'}->{'do_not_send_email'};

my $headers = $self->_envelope_headers($param);
$self->_send_mail(join("\n", $headers, '', $param->{body}));
}


=pod

=head2 send_mail_attach_file()

Sends an email message with a single attached file.

$obj->send_mail_attach_file(\%args);

%args supports:
- Required:
to
subject
body
file_content
- Optional:
from # Defaults to $obj->{email_sender}
cc
filename # default: "unnameded-" . $obj->{me} . ".txt"
content_type # default: text/plain

Returns _send_mail()

See _envelope_headers()

=cut

sub send_mail_attach_file
{
my $self = shift;
my $param = shift;

my $envelope_headers = $self->_envelope_headers($param);

my $boundary = join('_', '_----------=', $self->{me}, time());
my $body_length = length($param->{body});
my $filename = $param->{filename} || "unnammed-$self->{me}.txt";
my $content_length = length($param->{file_content});
my $content_type = $param->{content_type} || 'text/plain';


my $message = <<EOC;
Content-Transfer-Encoding: 7bit
Content-Type: multipart/mixed; boundary="$boundary"
MIME-Version: 1.0
$envelope_headers

This is a multi-part message in MIME format.

--$boundary
Content-Disposition: inline
Content-Length: $body_length
Content-Transfer-Encoding: binary
Content-Type: text/plain

$param->{body}
--$boundary
Content-Disposition: attachment; filename="$filename"
Content-Length: $content_length
Content-Transfer-Encoding: binary
Content-Type: text/plain; name="$filename"

$param->{file_content}
--$boundary--
EOC

$self->_send_mail($message);
}

=pod

=head2 _send_mail()

Send content into sendmail.

$obj->_send_mail($complete_message)

This means headers, body, the break between them.

Returns success on closing a handle, which should be useful.

Can raise an exception, which is formatted for CGI when applicable.
This messaging is to support being used from the shell.

=cut

sub _send_mail
{
my $self = shift;
my $message = shift;

# Redirect stdout to stderr, since stdout confuses apache
# The mess around die() is to send messaging based on CGI or not.
open( MAIL, "|/usr/sbin/sendmail $sendmail_opts -t 1>&2" )
|| do {
my $warning = "Sendmail failed: $! ($?)";
if ($ENV{GATEWAY_INTERFACE})
{
# get the message into the logs
warn $warning;
print
"Content-type: text/text\n"
. "\n"
. "CGI error: Can not open sendmail.\n"
. "Please report this error to $self->{site_admin_email} so that it may be fixed.\n"
. "Thank you.\n\n";
exit;
}
else
{
die $message;
}
};

print MAIL $message."\n";

return close(MAIL);
}

=pod

=head2 _envelope_headers()

Assemble standard envelope headers.
Return is list of headers or string of new line separated, based on call
context.

@headers = $obj->_envelope_headers(\%params);
$string = $obj->_envelope_headers(\%params);

# $string is: join("\n", @headers)
print qq|$string\n$more_headers\n\n$body|;


Supported input fields: to, cc, from, subject

Honors: safe_email_recip, email_sender.

Adds: "X-Mailer: $obj->{me}", "Date"

>From header defaults to $obj->{email_sender}


=cut

sub _envelope_headers
{
my $self = shift;
my $param = shift;

my $to = $param->{to};
my $cc = $param->{cc};
my $from = $param->{from} || $self->{email_sender};

# For testing, makes all mail go to safe_email_recip.
if ($self->{safe_email_recip})
{
$to = $self->{safe_email_recip};
$cc &&= $self->{safe_email_recip};
}

my $date = strftime '%a, %e %b %Y %H:%M:%S %Z', localtime;

my @headers = (
"To: $to",
"From: $from",
"Subject: $param->{subject}",
"Date: $date",
"X-Mailer: $self->{me}",
);
push @headers, "Cc: $cc" if $cc;


return wantarray ? @headers : join("\n", @headers);
}

=pod

=head2 http_data()

Get data using the CGI (Common Gateway Interface).

Returns in a hash or ref based on call context. List context is supported
for backward compatibility.

$data = $obj->http_data();
%data = $obj->http_data();

Return can be an empty ref.

=cut

sub http_data
{
my $self = shift;

my ( %results, $string, $key_value_pair, @key_value_sets, $key, $value );

if ( $ENV{'REQUEST_METHOD'} eq "POST" )
{
read( STDIN, $string, $ENV{'CONTENT_LENGTH'} );
}
else
{
$string = $ENV{'QUERY_STRING'};
}

$string =~ s/\+/ /g;

@key_value_sets = split( /&/, $string );

foreach $key_value_pair (@key_value_sets)
{
( $key, $value ) = split( /=/, $key_value_pair );

$key =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/ge;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/ge;

$results{$key} = $value;
}

return wantarray ? %results : \%results;
}

=pod

=head2 swrite()

Format text based on a picture.

$formatted = swrite($picture, @data);

Supports object notation for consistency.

$formatted = $obj->swrite($picture, @data);

See: perlform

=cut

sub swrite
{
my $this = shift if UNIVERSAL::isa($_[0], __PACKAGE__); # Polymorphic
my $pic = shift;

$^A = '';
formline($pic, @_);
my $ret = $^A;
$^A = '';
return $ret;
}

=pod

=head2 format_phone()

Format a (US) telephone number for humans, area code is optional.

$formatted = $obj->format_phone('12223334444');
# $formatted = '222-333-4444'

Any extra characters are stripped out, meaning input may be messy.

=cut

sub format_phone
{
my $this = shift if UNIVERSAL::isa($_[0], __PACKAGE__); # Polymorphic
my $phone = shift;

$phone =~ s/\D//g;
$phone =~ s/^1?((?:\d{3})?)(\d{3})(\d{4})/my $s = "$1-" if $1;"$s$2-$3"/e;
$phone;
}


=pod


=head1 Credit card handling

=head2 validate_card()

Validate credit card information.

$validated = $obj->validate_card($card_num, $exp_mo, $exp_y, \@errors);

Returns hashref of well formatted values, undef on failure.

$validated = {
num => '4111111111111111',
type => 'Visa',
exp_yr => 2015,
exp_mo => '03',
num_last_four => 1111,
num_formatted => '4111-1111-1111-1111',
num_parts => [qw(4111 1111 1111 1111)],
exp_yr_yy => 15,
}

Adds to @errors.

Checks card number, expiration.

Card number may be a string or a ref to a list of parts. eg:
'4111111111111111'
['4111', '1111', '1111', '1111']

Sample CC numbers to test with:
4111-1111-1111-1111 : Visa
5555-5555-5555-4444 : MasterCard
6011-1111-1111-1117 : Discover

=cut

sub validate_card
{
my $self = shift;
my ( $cardNum, $exp_m, $exp_y, $errors ) = @_;

my %ret;

if (UNIVERSAL::isa($cardNum, 'ARRAY'))
{
$cardNum = join('', @{$cardNum});
}

# remove all but digits
$cardNum =~ s/\D//g;

my @e;
if ( ! ((length($cardNum) == 16 ) && $self->luhn10_ok($cardNum)) )
{
push @e, "Credit Card Number Invalid";
}
else
{
# undef == bad card type
if (my $cc_type = $self->get_cc_type( $cardNum ))
{
$ret{type} = $cc_type;
}
else
{
push @e, "Credit Card Number type unkown";
}
}

if (my $exp = $self->check_cc_exp( $exp_m, $exp_y, \@e ))
{
$ret{$_} = $exp->{$_} foreach keys %{$exp};
}

if (@e)
{
push @{$errors}, @e;
}
# card is good
else
{
$ret{num} = $cardNum;

# Add other formats
my @parts = $ret{num} =~ m/(\d{4})(\d{4})(\d{4})(\d{4})/;
$ret{num_parts} = \@parts;
$ret{num_formatted} = join('-', @parts);
$ret{num_last_four} = $parts[3];
}

return @e ? undef : \%ret;
}


=pod

=head2 luhn10_ok()

Luhn 10 check.

$ok = $obj->luhn10_ok($cc_num);

Returns 1 on success, 0 on failure.

Input is expected to be a 16 digit string.

=cut

sub luhn10_ok
{
my $self = shift;

my @cardNum = split //, shift;
for my $i ( map { $_ * 2 } 0 .. $#cardNum / 2 ) {
$cardNum[$i] *= 2;
$cardNum[$i] -= 9 if $cardNum[$i] >= 10;
}
my $total = 0;
$total += $_ for (@cardNum);
return +($total % 10 == 0) ? 1 : 0;
}

=pod

=head2 check_cc_exp()

Check expiration for valid, not expired, etc.

$formatted = $obj->check_cc_exp($exp_mo, $exp_yr, \@errors)

Month is expected to be 1-2 digits long, year is 2 or 4 digits.

Returns: undef on fail, else hashref of well formatted
$formatted = {
exp_yr => 2015,
exp_mo => '03',
exp_yr_yy => 15,
}

Adds to @errors.
Invalid
Expired
Too far in future

=cut

sub check_cc_exp
{
my $self = shift;
my ( $month, $year, $errors ) = @_;

my %ret;
my $invalid = 1; # guilty until proven inocent

if ( $year > 0 && $month > 0 && $month <= 12 )
{
# Convert 2 digit year to 4 digit and ensure 2 digit month.
$year += 2000 if $year < 100;
$month = sprintf('%02u', $month);

my $expiration = join('-', $year, $month);

my ( $y, $m ) = (localtime)[ 5, 4 ];
$y += 1900; $m += 1;
my $today = sprintf( '%u-%02u', $y, $m );

if ( $expiration lt $today )
{
$invalid = 2;
}
else {
# Allow 10 years into future, since a human will be confirming later.
my $future = sprintf('%u-%02u', $y + 10, $m);
if ( $expiration ge $future )
{
$invalid = 3;
}
else
{
$invalid = 0;
%ret = (exp_yr => $year, exp_mo => $month, exp_yr_yy => substr($year, 2));
}
}
}

if ($invalid)
{
my %reasons = (
1 => 'Invalid',
2 => 'Expired',
3 => 'Too far in future'
);
push @{$errors}, 'Expiration date: '. $reasons{$invalid};
}

return $invalid ? undef : \%ret;
}

=pod

=head2 get_cc_type()

Determine credit card type based on the card number.

$cc_type = $obj->get_cc_type($cc_number);

Returns CC type as a string, undef if type isn't recognized.

=cut

sub get_cc_type
{
my $self = shift;
my $cc_num = shift;

# Taken from Business::CreditCard

my $cc_type;
if ($cc_num =~ /^5[1-5]/) {
$cc_type = 'MasterCard';
}
elsif ($cc_num =~ /^6011/)
{
$cc_type = 'Discover';
}
elsif ($cc_num =~ /^4/)
{
$cc_type = 'Visa';
}
return $cc_type;
}



=pod

=head1 VERSION

2016-11-02-002


=cut


1;

__END__



This post has been edited by citabriabob: Jul 27 2020, 04:53 PM
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
Christian J
post Jul 28 2020, 07:35 AM
Post #4


.
********

Group: WDG Moderators
Posts: 8,619
Joined: 10-August 06
Member No.: 7



The W3C validator reports several HTML problems that may or may not contribute: https://validator.w3.org/check?uri=https%3A...ine&group=0
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
pandy
post Jul 28 2020, 08:04 AM
Post #5


Computer says no.
********

Group: WDG Moderators
Posts: 19,222
Joined: 9-August 06
Member No.: 6



It's strange that it only happens occasionally. unsure.gif
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
citabriabob
post Jul 28 2020, 03:39 PM
Post #6


Newbie
*

Group: Members
Posts: 10
Joined: 27-July 20
Member No.: 27,457



I'm sorry that I didn't do the validation of the html; I thought that I was perfect -wink.gif

Corrected most errors and cut out a lot of the commented out sections. Still don't understand why autocomplete and hspace are flagged.

Unfortunately, I cannot test this due to the random nature of the problem.

Thanks to all.
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
Christian J
post Jul 28 2020, 04:06 PM
Post #7


.
********

Group: WDG Moderators
Posts: 8,619
Joined: 10-August 06
Member No.: 7



QUOTE(citabriabob @ Jul 28 2020, 10:39 PM) *

Still don't understand why autocomplete and hspace are flagged.

Edit: Those are proprietary browser extensions, and not part of the W3C spec. Probably all browsers ignore them today.

Only HSPACE is proprietary and ignored. AUTOCOMPLETE is valid HTML, but since the page uses an older HTML4 Doctype (that does not include AUTOCOMPLETE or HSPACE) the validator complains. If you changed to a newer Doctype the error would go away, but since the page is otherwise made up of HTML4 elements and attributes the validator might flag other errors instead (that are no longer valid in HTML5). Browsers should not be affected by any of this though.

QUOTE
Unfortunately, I cannot test this due to the random nature of the problem.

Are you sure the form submissions are done by real customers, and not some kind of bot?

You could also check if some particular browser is causing this. You mentioned a "chrome problem"?

This post has been edited by Christian J: Nov 2 2020, 08:42 PM
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
citabriabob
post Jul 28 2020, 04:26 PM
Post #8


Newbie
*

Group: Members
Posts: 10
Joined: 27-July 20
Member No.: 27,457



Are you sure the form submissions are done by real customers, and not some kind of bot? Absolutely. They are known club members.

You could also check if some particular browser is causing this. You mentioned a "chrome problem" I was told that Chrome ignores the autocomplete settings, but another customer used another browser, same result. Wish I had noted what he used.
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
pandy
post Jul 28 2020, 04:38 PM
Post #9


Computer says no.
********

Group: WDG Moderators
Posts: 19,222
Joined: 9-August 06
Member No.: 6



I don't think some old attributes can cause this anyway.

One thing, is the number of items ordered always 28 when it goes wrong?
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
citabriabob
post Jul 28 2020, 05:40 PM
Post #10


Newbie
*

Group: Members
Posts: 10
Joined: 27-July 20
Member No.: 27,457



No. I just checked another order and it was 85. Quantities are uniform per order. I thought that some text might be bleeding through ASCII 28 is a file separator; 85 is a capital U. Just guessing.
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
pandy
post Jul 28 2020, 06:35 PM
Post #11


Computer says no.
********

Group: WDG Moderators
Posts: 19,222
Joined: 9-August 06
Member No.: 6



OK. Another thing. Did the customer actually order all those items but of course a more reasonably amount of them, or are parts of the order a total fake?

Just trying to find some kind of logic here...
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
citabriabob
post Jul 28 2020, 06:48 PM
Post #12


Newbie
*

Group: Members
Posts: 10
Joined: 27-July 20
Member No.: 27,457



Those items were NOT ordered; they appeared totally out of the blue.

If you have a mix of browsers, I welcome you to place orders. Use 4111 1111 1111 1111 as credit card. Your name and address are not required to be correct. If you do, please say browser name in comments.

Thanks,
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
pandy
post Jul 28 2020, 07:29 PM
Post #13


Computer says no.
********

Group: WDG Moderators
Posts: 19,222
Joined: 9-August 06
Member No.: 6



Oh! So the affected member weren't there at all? This is beginning to sound really serious. Are the CC numbers stored on the server?
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
pandy
post Jul 28 2020, 07:39 PM
Post #14


Computer says no.
********

Group: WDG Moderators
Posts: 19,222
Joined: 9-August 06
Member No.: 6



I filled out the form a couple of times. The confirmation page was correct.
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
citabriabob
post Jul 28 2020, 07:41 PM
Post #15


Newbie
*

Group: Members
Posts: 10
Joined: 27-July 20
Member No.: 27,457



QUOTE(pandy @ Jul 28 2020, 08:29 PM) *

Oh! So the affected member weren't there at all? This is beginning to sound really serious. Are the CC numbers stored on the server?


Nothing is stored on the server. charging is manual. Thnaks.
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
pandy
post Jul 28 2020, 08:33 PM
Post #16


Computer says no.
********

Group: WDG Moderators
Posts: 19,222
Joined: 9-August 06
Member No.: 6



But when you get those fishy form submissions there is a CC number entered, isn't it? Is it a real number and does the card belong to the member who's name is used? If so, it must come from somewhere. wacko.gif
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
citabriabob
post Jul 29 2020, 02:20 PM
Post #17


Newbie
*

Group: Members
Posts: 10
Joined: 27-July 20
Member No.: 27,457



Can you recommend someone who is paid to fix this?
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
pandy
post Jul 29 2020, 02:37 PM
Post #18


Computer says no.
********

Group: WDG Moderators
Posts: 19,222
Joined: 9-August 06
Member No.: 6



Sorry, don't know.

Please answer my question about the CC numbers. I worry about that bit.
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
citabriabob
post Nov 1 2020, 01:14 PM
Post #19


Newbie
*

Group: Members
Posts: 10
Joined: 27-July 20
Member No.: 27,457



OK. Given that I am unable to find the source of this issue and most orders are received correctly, I would like to eliminate (set qty to 0)? any item with a quantity greater than 9. Is this easy to do?
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post
Christian J
post Nov 1 2020, 06:31 PM
Post #20


.
********

Group: WDG Moderators
Posts: 8,619
Joined: 10-August 06
Member No.: 7



QUOTE(citabriabob @ Nov 1 2020, 07:14 PM) *

I would like to eliminate (set qty to 0)? any item with a quantity greater than 9. Is this easy to do?

The time-consuming part should be to understand where in the script to add it, otherwise it's trivial.

An simpler alternative might be to use an INPUT TYPE=RANGE or (more compact) INPUT TYPE=NUMBER form field instead of an ordinary text field in the HTML code. That way you can limit the max value submitted by normal users. However it does not prevent bots, malware or malicious users from submitting bogus form data. See also
https://www.w3schools.com/tags/att_input_type_range.asp and
https://www.w3schools.com/tags/att_input_type_number.asp


But I'm not sure what you meant with this reply from July 29th:

QUOTE
Those items were NOT ordered; they appeared totally out of the blue.

Did you mean that:

1. The customer did place an order, but extra items in the order appeared out of the blue?

2. Or did the entire order including the CC number appears out of the blue?
User is offlinePM
Go to the top of the page
Toggle Multi-post QuotingQuote Post

2 Pages V  1 2 >
Reply to this topicStart new topic
1 User(s) are reading this topic (1 Guests and 0 Anonymous Users)
0 Members:

 



- Lo-Fi Version Time is now: 23rd November 2020 - 05:55 PM