#!/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; } ##################################################