Select Category dropdowns?

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hi, I have been trying to find someone to help me create Perl Dynamic Dropdowns in my auction site... http://www.efret.com/cgi-bin/test/test34.pl?action=new (please disregard first dropdown...doesn't work) (go down to select category, click automobiles, hit go,...) This displays subcats on new p[age instead of in the 2nd dropdown? I am getting closer, but don't know how to: Make my dropdfown list selectable(without hitting "go")? or Get the correct subcats to display when "go" button is hit? Get the 2nd dropdwon box to display respective sub cats? and display "no more subcats", when finished? Can anyone help? Here is my code:

#-#############################################
# Sub: Add New Item
# This allows a new item to be put up for sale

sub new {

######################################################################
+#####################
print "<form ACTION=$ENV{'SCRIPT_NAME'} method=post> ",

    my $catinfo="<!--$form{category}-->";$catinfo=~s/\:/--><!--/g;$cat
+info=~s/<!---->//g;
    umask(000);
    my($key, %numfiles, %mycategory, %caticon);
    foreach $key (keys %category) {
        next if $category{$key}!~/^\Q$catinfo\E/;
         opendir(THEDIR, "$config{'basepath'}$key") || mkdir("$config{
+'basepath'}$key", 0777) || &oops("Category directory $key could not b
+e opened.");
        readdir THEDIR;readdir THEDIR;
        my @allfiles = readdir THEDIR;
        closedir THEDIR;
        if($category{$key} =~ /^\Q$catinfo\E<!--([^>]*)-->/ && $superc
+at{$1} ne ''){
            $mycategory{"$form{category}:$1"} = $supercat{$1};
            $numfiles{"$form{category}:$1"} += @allfiles;
            $caticon{"$form{category}:$1"} = $config{supercaticon};
        }else{
            $mycategory{$key} = $category{$key};
            $numfiles{$key} += @allfiles;
            $caticon{$key} = $config{regularcaticon};
        }
    }
    my $cols = $config{maincatcols} || 2;
    my $pc = int(100/$cols);

print "<select name=category>",

    my @keys = sort {lc $mycategory{$a} cmp lc $mycategory{$b}} keys %
+mycategory;
    my $definedkeys = $#keys + $cols-(($#keys+1)%$cols);
    my $cmove = int(@keys/$cols);
    $cmove++ if (@keys%$cols);
    for(my $i = 0;$i<=$cmove-1;$i++) {
#    print "<tr>";
        my $j = $i;
        for(1..$cols){
            my $key=$keys[$j];
            if($key ne ''){
print "<OPTION value=$key>@mycategory{$key}</OPTION>",
            }else{
                print(
                    # Print Padding (Empty Cells)
                    "<td>&nbsp;</td>",
                );
            }
            $j+=$cmove;
        }
    }
print (
"</select>",
"<INPUT TYPE='SUBMIT' NAME=action VALUE='go'>",
"</tr>",

);
######################################################################
+#####################

    my ($title, $reserve, $inc, $desc, $image, $buyit, @bids);
    my $inc = '1.00'; # default increment
    if ($form{'REPOST'}) {
        $form{'REPOST'} =~ s/\W//g;
        if (-T "$config{'basepath'}$config{'closedir'}/$form{'REPOST'}
+.dat") {
            open THEFILE, "$config{'basepath'}$config{'closedir'}/$for
+m{'REPOST'}.dat";
            ($title, $reserve, $inc, $desc, $image, $buyit, @bids) = <
+THEFILE>;
            close THEFILE;
            chomp($title, $reserve, $inc, $desc, $image, $buyit, @bids
+);
        }
    }
    print <<"EOF";

<!-- Add the following line to add a back button - between (print <<"E
+OF";) & (EOF) -->

    <input type="button" name="Button" value="Back" onClick="MM_callJS
+('if (history.length     &gt; 0){history.back()}')">



#####################
# Post new Item Form
<FORM ACTION=$ENV{'SCRIPT_NAME'} METHOD=POST>
<H2>Post A New Item</H2>
<TABLE WIDTH=100% BORDER=1 BGCOLOR=$config{'colortablebody'}>
<INPUT TYPE=HIDDEN NAME=action VALUE=procnew>
<TR><TD VALIGN=TOP><B>Title/Item Name:<BR></B>No HTML</TD><TD><INPUT N
+AME=TITLE VALUE=\"$title\" TYPE=TEXT SIZE=50 MAXLENGTH=50></TD></TR>
<TR><TD VALIGN=TOP><B>Category:<BR></B>Select One</TD><TD>

#####################
# Select Main Cat pulldown

<FORM ACTION=$ENV{'SCRIPT_NAME'} METHOD=POST>
EOF

    my $catinfo="<!--$form{category}-->";$catinfo=~s/\:/--><!--/g;$cat
+info=~s/<!---->//g;
    umask(000);
    my($key, %numfiles, %mycategory, %caticon);
    foreach $key (keys %category) {
        next if $category{$key}!~/^\Q$catinfo\E/;
         opendir(THEDIR, "$config{'basepath'}$key") || mkdir("$config{
+'basepath'}$key", 0777) || &oops("Category directory $key could not b
+e opened.");
        readdir THEDIR;readdir THEDIR;
        my @allfiles = readdir THEDIR;
        closedir THEDIR;
        if($category{$key} =~ /^\Q$catinfo\E<!--([^>]*)-->/ && $superc
+at{$1} ne ''){
            $mycategory{"$form{category}:$1"} = $supercat{$1};
            $numfiles{"$form{category}:$1"} += @allfiles;
            $caticon{"$form{category}:$1"} = $config{supercaticon};
        }else{
            $mycategory{$key} = $category{$key};
            $numfiles{$key} += @allfiles;
            $caticon{$key} = $config{regularcaticon};
        }
    }
    my $cols = $config{maincatcols} || 2;
    my $pc = int(100/$cols);
print "<SELECT NAME=CATEGORY>",


    my @keys = sort {lc $mycategory{$a} cmp lc $mycategory{$b}} keys %
+mycategory;
    my $definedkeys = $#keys + $cols-(($#keys+1)%$cols);
    my $cmove = int(@keys/$cols);
    $cmove++ if (@keys%$cols);
    for(my $i = 0;$i<=$cmove-1;$i++) {
#    print "<tr>";
        my $j = $i;
        for(1..$cols){
            my $key=$keys[$j];
            if($key ne ''){
print "<OPTION value=$key>@mycategory{$key}</OPTION>",
            }else{
                print(
                    # Print Padding (Empty Cells)
                    "<td>&nbsp;</td>",
                );
            }
            $j+=$cmove;
        }
    }

print "</select>",
print "<INPUT TYPE='submit' NAME=action VALUE=go>",
#print "</tr>",


    print <<"EOF";

print "<INPUT TYPE='submit' NAME=action VALUE=go>",
<SELECT NAME=CATEGORY TYPE=TEXT SIZE=5>
<OPTION SELECTED>Test2</OPTION>
EOF
    my $key;
    foreach $key (sort keys %category) {
        print "<OPTION VALUE=\"$key\">$category{$key}</OPTION>\n";
    }
    print <<"EOF";
</SELECT></TD></TR>
</SELECT></TD></TR>
#########################
<TR><TD VALIGN=TOP><B>Image URL:<BR></B>Optional, should be no larger 
+than 200x200</TD><TD><INPUT NAME=IMAGE VALUE=\"$image\" TYPE=TEXT SIZ
+E=50 VALUE="http://"></TD></TR>
<TR><TD VALIGN=TOP><B>Days Until Close:<BR></B>1-30</TD><TD><INPUT NAM
+E=DAYS TYPE=TEXT SIZE=2 MAXLENGTH=2></TD></TR>
<TR><TD VALIGN=TOP><B>Description:<BR></B>May include HTML - This shou
+ld include the condition of the item, payment and shipping informatio
+n, and
any other information the buyer should know.</TD><TD><TEXTAREA NAME=DE
+SC ROWS=5 COLS=45>$desc</TEXTAREA></TD></TR>
<TR><TD COLSPAN=2 VALIGN=TOP>Please note that by placing an item up fo
+r bid you are making a contract between you and the buyer.<br>
Once you place an item, you may not retract it and you must sell it fo
+r the highest bid.<br>
In other words, if you don't want to sell it, don't place it up for bi
+d!
EOF

    if ($config{'regdir'}) {
        print <<"EOF";
<P><B><A HREF="$ENV{'SCRIPT_NAME'}?action=reg">Registration</A> is req
+uired to post or bid!</B></TD></TR>
<TR><TD VALIGN=TOP><B>Your Handle/Alias:<BR></B>Used to track your pos
+t</TD><TD><INPUT NAME=ALIAS TYPE=TEXT SIZE=30 MAXLENGTH=30>
<TR><TD VALIGN=TOP><B>Your Password:<BR></B>Must be valid</TD><TD><INP
+UT NAME=PASSWORD TYPE=PASSWORD SIZE=30>
<TR><TD VALIGN=TOP><B>Your Starting Bid:</B></TD><TD>\$<INPUT NAME=BID
+ TYPE=TEXT SIZE=7 VALUE=0>
<TR><TD VALIGN=TOP><B>Your Reserve Price:<BR></B>You are not obligated
+ to sell below this price.  Leave blank if none.</TD><TD>\$<INPUT NAM
+E=RESERVE TYPE=TEXT SIZE=7 VALUE=0>

<!-- ############################ -->
<TR><TD VALIGN=TOP><B>Bid Increment:</B></TD><TD>\$<INPUT NAME=INC TYP
+E=TEXT SIZE=7 VALUE="$inc"></TD></TR>
<TR><TD VALIGN=TOP><B>Buy-it Now:</B><BR>Optional, this feature allows
+ the first bidder to win the auction with a bid at this set price.</T
+D><TD>\$<INPUT NAME="BUYIT" TYPE="text" SIZE="7"></TD></TR></TABLE>
<!-- ############################ -->


EOF
    }
    else {
        print <<"EOF";
</TD></TR>
<TR><TD VALIGN=TOP><B>Your Handle/Alias:<BR></B>Used to track your pos
+t</TD><TD><INPUT NAME=ALIAS TYPE=TEXT SIZE=30 MAXLENGTH=30>
<TR><TD VALIGN=TOP><B>Your E-Mail Address:<BR></B>Must be valid</TD><T
+D><INPUT NAME=EMAIL TYPE=TEXT SIZE=30>
<TR><TD VALIGN=TOP><B>Your Starting Bid:</B></TD><TD>\$<INPUT NAME=BID
+ TYPE=TEXT SIZE=7 VALUE=0>
<TR><TD VALIGN=TOP><B>Your Reserve Price:<BR></B>You are not obligated
+ to sell below this price.  Leave blank if none.</TD><TD>\$<INPUT NAM
+E=RESERVE TYPE=TEXT SIZE=7 VALUE=0>
<TR><TD VALIGN=TOP><B>Bid Increment:</B></TD><TD>\$<INPUT NAME=INC TYP
+E=TEXT SIZE=7 VALUE="$inc">

<!-- ############################ -->
<TR><TD VALIGN=TOP><B>Buy-it Now:</B><BR>Optional, this feature allows
+ the first bidder to win the auction with a bid at this set price.</T
+D><TD>\$<INPUT NAME="BUYIT" TYPE="text" SIZE="7">
<!-- ############################ -->



<TR><TD VALIGN=TOP><B>Contact Information:<BR></B>Will be given out on
+ly to the buyer</TD><TD>
<TT>Full Name: </TT><BR><INPUT NAME=ADDRESS1 TYPE=TEXT SIZE=30><BR>
<TT>Street Address: </TT><BR><INPUT NAME=ADDRESS2 TYPE=TEXT SIZE=30><B
+R>
<TT>City, State, ZIP: </TT><BR><INPUT NAME=ADDRESS3 TYPE=TEXT SIZE=30>
+</TD></TR></TABLE>
EOF
    }
    print <<"EOF";
<CENTER>Adult Content IS NOT Allowed!!! <INPUT TYPE=SUBMIT VALUE=Previ
+ew></CENTER>
EOF
}
[download]

20040711 Edit by ysth: add code tags

edit (broquaint): added <readmore> tag

Comment on Select Category dropdowns? Download Code

Replies are listed 'Best First'.
Re: Select Category dropdowns? by arden (Curate) on Jul 11, 2004 at 22:42 UTC
Anonymous, let me see if I have you right: You want us to go through a couple hundred lines of your code which you know doesn't work and figure out why it doesn't work without you providing us with anything more than the entire, ugly block of code? You didn't even get your post right, ysth had to edit it for you to make it readable! What have you already tried? What errors are you getting? What exactly do you expect it to do? What parts of the code do you know aren't the problem (and why have you included them)? You really need to narrow down your problem and post a specific test-case that fails. We're here to help you with the last 5-10% of your project, we expect you to do most of the trouble-shooting. Otherwise, hire a Perl consultant (there are several here). Oh yeah, why are you trying to do sub-menus with Perl? As much as I love it (and promote it's use whenever it fits the bill), java(script) is much more suited to the task. - - arden.	[reply]
A reply falls below the community's threshold of quality. You may see it by logging in.
A reply falls below the community's threshold of quality. You may see it by logging in.