I'm really new to Perl and am learning as I go. My boss gave me a
program to look over that they're thinking of implementing. It seems to
be a GPL auction program. As I was looking through the code, I was
puzzled by one part... the part that displays subcategories on the users
screen. I've copied snippets of the code below. Specifically - the "sub"
is called by the line of code in the top block - I.E. the "washers" sub
is called to display the "washers" subcategory. What sort of seems very
inefficient is if I want to add twenty more categories I have to
duplicate and add (with minor changes) 20 more "subs". This will really
result in program bloat if we have many subcategories... Isn't it
possible to somehow only have ONE "sub" and pass parameters to it in the
call to it that can make a "generic" sub work for ALL the subcategories
we want to use? If so, any suggestions on how I can do this? (I'm aware
that the solution may be obvious to Perl experts, but sadly not to me
yet.... but it seems like in other languages this is possible...but how
in Perl?). Thanks!!
The calling lines followed by the "subs"...
========================================================================
==========
elsif ($form{'action'} eq 'washers') { &washers; } #washers
Category
elsif ($form{'action'} eq 'bolts') { &bolts; } #bolts
Category
elsif ($form{'action'} eq 'cotterpins') { &cotterpins; } #cotterpins
Items Category
========================================================================
==========
sub washers {
&chkclose;
print $config{'subheader'};
print "<div align=center><center>";
print "<table border=0 cellspacing=0 style=border-collapse:
collapse width=50% bgcolor=$config{'colortablehead'}>";
print "<tr><td width=100%>";
print "<div align=center><center>";
print "<table border=0 cellpadding=2 cellspacing=0
style=border-collapse:collapse bordercolor=$config{'colortablehead'}
width=100%>";
print "<tr><td width=100% colspan=2
bgcolor=$config{'colortablehead'}>";
print "<p align=center><b><font color=$config{'colortablebody'}
face=Arial size=2>Washers Categories</font></b></td></tr>";
my $key;
foreach $key (sort keys %washers) {
umask(000); # UNIX file permission junk
mkdir("$config{'basepath'}$key", 0777) unless (-d
"$config{'basepath'}$key");
opendir DIR, "$config{'basepath'}$key" or &oops("Category
directory $key could not be opened.");
my $numfiles = scalar(grep -T, map "$config{'basepath'}$key/$_",
readdir DIR);
closedir DIR;
print "<tr><td width=87% bgcolor=$config{'colortablebody'}>";
print "<p align=left><font face=Arial><small><A
HREF=$ENV{'SCRIPT_NAME'}\?category=$key\&listtype=current>$category{$key
}</A></td>";
print "<td width=13% bgcolor=$config{'colortablebody'}><font
SIZE=2 face=Arial><p
align=center><b>\($numfiles\)</b></font></td></tr>";
}
print "</table></center></div></td></tr></table></center></div>\n";
}
sub bolts {
&chkclose;
print $config{'subheader'};
print "<div align=center><center>";
print "<table border=0 cellspacing=0 style=border-collapse:
collapse width=50% bgcolor=$config{'colortablehead'}>";
print "<tr><td width=100%>";
print "<div align=center><center>";
print "<table border=0 cellpadding=2 cellspacing=0
style=border-collapse:collapse bordercolor=$config{'colortablehead'}
width=100%>";
print "<tr><td width=100% colspan=2
bgcolor=$config{'colortablehead'}>";
print "<p align=center><b><font color=$config{'colortablebody'}
face=Arial size=2>bolts Categories</font></b></td></tr>";
my $key;
foreach $key (sort keys %bolts) {
umask(000); # UNIX file permission junk
mkdir("$config{'basepath'}$key", 0777) unless (-d
"$config{'basepath'}$key");
opendir DIR, "$config{'basepath'}$key" or &oops("Category
directory $key could not be opened.");
my $numfiles = scalar(grep -T, map "$config{'basepath'}$key/$_",
readdir DIR);
closedir DIR;
print "<tr><td width=87% bgcolor=$config{'colortablebody'}>";
print "<p align=left><font face=Arial><small><A
HREF=$ENV{'SCRIPT_NAME'}\?category=$key\&listtype=current>$category{$key
}</A></td>";
print "<td width=13% bgcolor=$config{'colortablebody'}><font
SIZE=2 face=Arial><p
align=center><b>\($numfiles\)</b></font></td></tr>";
}
print "</table></center></div></td></tr></table></center></div>\n";
}
sub Cotterpins {
&chkclose;
print $config{'subheader'};
print "<div align=center><center>";
print "<table border=0 cellspacing=0 style=border-collapse:
collapse width=50% bgcolor=$config{'colortablehead'}>";
print "<tr><td width=100%>";
print "<div align=center><center>";
print "<table border=0 cellpadding=2 cellspacing=0
style=border-collapse:collapse bordercolor=$config{'colortablehead'}
width=100%>";
print "<tr><td width=100% colspan=2
bgcolor=$config{'colortablehead'}>";
print "<p align=center><b><font color=$config{'colortablebody'}
face=Arial size=2>Cotterpins Items Categories</font></b></td></tr>";
my $key;
foreach $key (sort keys %Cotterpins) {
umask(000); # UNIX file permission junk
mkdir("$config{'basepath'}$key", 0777) unless (-d
"$config{'basepath'}$key");
opendir DIR, "$config{'basepath'}$key" or &oops("Category
directory $key could not be opened.");
my $numfiles = scalar(grep -T, map "$config{'basepath'}$key/$_",
readdir DIR);
closedir DIR;
print "<tr><td width=87% bgcolor=$config{'colortablebody'}>";
print "<p align=left><font face=Arial><small><A
HREF=$ENV{'SCRIPT_NAME'}\?category=$key\&listtype=current>$category{$key
}</A></td>";
print "<td width=13% bgcolor=$config{'colortablebody'}><font
SIZE=2 face=Arial><p
align=center><b>\($numfiles\)</b></font></td></tr>";
}
print "</table></center></div></td></tr></table></center></div>\n";
}
Portions of this message may be confidential under an exemption to Ohio's
public records law or under a legal privilege. If you have received this
message in error or due to an unauthorized transmission or interception, please
delete all copies from your system without disclosing, copying, or transmitting
this message.
