Sub coding question...

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.

Relevant Pages

  • [tip:perf/scripting] perf trace: Add perf trace scripting support modules for Perl
    ... Add Perf-Trace-Util Perl module and some scripts that use it. ... new file mode 100644 ... +GNU General Public License version 2 as published by the Free ... +sub define_flag_field ...
    (Linux-Kernel)
  • RE: returning hashes, and arrays
    ... :> subroutine named link(). ... :> array interchangeably here. ... : 'Learning Perl'; ... : sub ParseLineForHomeAndVisitors; ...
    (perl.beginners)
  • Re: Shifting Away
    ... are there two armed camps of Perl monks throwing gazillion megawatt ... daily at shift change and shout "When should I use an en dash?" ... become a bit less paranoid now but it's hard to let go of formal params. ... in the argument list and the sub could still change that. ...
    (comp.lang.perl.misc)
  • [RFC][PATCH 4/7] perf trace: Add perf trace scripting support modules for Perl
    ... Add Perf-Trace-Util Perl module and some scripts that use it. ... new file mode 100644 ... +GNU General Public License version 2 as published by the Free ... +sub define_flag_field ...
    (Linux-Kernel)
  • Re: Hardware hackers rejoice!
    ... I've tried to warm up to Perl ... sub getvar { ... # Given 0, the fan is off. ... # Display to LCD ...
    (Ubuntu)