#!/usr/bin/perl -w
use strict;
use warnings;
my $SELF = 'http://www.wzsn.net/perl/productDB.pl';
my $ARGS = exists($ENV{QUERY_STRING}) ? $ENV{QUERY_STRING} : '';
my $ITEM = GetArgString($ARGS, 'selectedItem', 'X');
my @PRODUCTS = ();
my @PRICE = ();
my @ID = ();
my @STOCK = ();
NewProduct('Apples', '000001', '3.99', '10 boxes');
NewProduct('Oranges', '000002', '2.99', '17 boxes');
NewProduct('Cherries', '000003', '5.47', '2 boxes');
NewProduct('Milk', '000004', '3.69', '85 gallons');
NewProduct('Sprite', '000005', '1.99', '240 bottles');
NewProduct('Wine', '000006', '7.89', '0 liters');
if (isNumber($ITEM))
{
DisplayItemDetails($ITEM);
}
else
{
DisplayProductList();
}
exit;
###############################################################
sub DisplayProductList
{
print "Pragma: no-cache\n";
print "Content-Type: text/html\n\n";
print "
\n\n";
print "Product List
";
print "\n";
print "Number | ID | Price | Product Name | Stock";
for (my $i = 0; $i < @PRODUCTS; $i++)
{
my $BGCOLOR = $i & 1 ? 'FFFFFF' : 'E8E8E8';
my $QUANTITY = $STOCK[$i];
$QUANTITY =~ tr|0-9||cd; # Remove everything except digits 0-9
print " |
", ($i+1), " | ", $ID[$i], " | ", $PRICE[$i], " | ", $PRODUCTS[$i], " | ", $STOCK[$i];
}
print " |
\n\n";
}
###############################################################
sub DisplayItemDetails
{
print "Pragma: no-cache\n";
print "Content-Type: text/html\n\n";
print "\n";
my $ITEM = defined $_[0] ? $_[0] : 0;
if ($ITEM < 0 || $ITEM >= @PRODUCTS) { print "Invalid item selected.
Return to Product List"; return; }
print "Product Details
";
print "";
print "Product Name | = | ", $PRODUCTS[$ITEM];
print " |
ID | = | ", $ID[$ITEM];
print " |
Price | = | ", $PRICE[$ITEM];
print " |
Stock | = | ", $STOCK[$ITEM];
print " |
\n";
print "
Return to Product List";
print "\n\n";
}
###############################################################
# Usage: NewProduct(NAME, ID, PRICE, STOCK)
sub NewProduct
{
@_ >= 4 or return;
push(@PRODUCTS, $_[0]);
push(@ID, $_[1]);
push(@PRICE, $_[2]);
push(@STOCK, $_[3]);
}
##################################################
# v2020.12.4
# Extracts the first occurrence of a named value
# from ARGUMENT_LIST and returns it. If the value
# is not found, then an empty string is returned.
# Value names are case sensitive. Example:
# GetArgString('?p=12x48&r=XXX&c=990', 'r') ---> 'XXX'
#
# Usage: VALUE = GetArgString(ARGUMENT_LIST, ARGUMENT_NAME, [DEFAULT_VALUE])
#
sub GetArgString
{
my $ARGS = defined $_[0] ? $_[0] : '';
my $NAME = defined $_[1] ? $_[1] : '';
my $DEFAULT = defined $_[2] ? $_[2] : '';
length($NAME) or return $DEFAULT;
my $P = index("&$ARGS", "&$NAME=") + 1;
$P or return $DEFAULT;
$P += length($NAME);
my $L = index($ARGS, '&', $P);
return $L < 0 ? substr($ARGS, $P) : substr($ARGS, $P, $L - $P);
}
##################################################
# v2019.11.23
# This function returns 1 if the input value is
# a number; returns zero otherwise.
# Usage: INTEGER = isNumber(VALUE)
#
sub isNumber
{
defined $_[0] or return 0;
my $R = 1;
local $SIG{__WARN__} = sub { $R = 0; };
return ($_[0] < 0) ? $R : $R;
}
##################################################