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

Hi Monks, I found a tutorial for a simple database CGI script and I am wanting to build on it, so it accepts input via a web form using drop down menus, instead of text boxes.
The tutorial is perfect for what I am trying to make and already includes subroutines for searches and deleting records. I am trying to make a simple change management database via a web browser form, but I do not want to be typing all the information in the text boxes. It says in the tutorial that only text and textarea boxes are supported for the type of field, but I was thinking with a bit of a change I could change that to drop down boxes, or option buttons. Perhaps by having separate hashes for the menu items.

The full tutorial with the whole listing of code is at: Link to tutorial I've included some of the original code snippets and what I have changed them to.
It originally listed these values as a hash of arrays.

# Define Your Database Fields Here Like So # Field Name => [Number, 'Readable Name', 'type of field, two op +tions are text or textarea' #%fields = ( # ID => [0, 'Link ID:', + 'text'], # Name => [1, 'Name:', + 'text'], # Email => [2, 'E-Mail Address:', + 'text'], # Phone => [3, 'Phone Number:', + 'text'], # Address => [4, 'Street Address:', + 'textarea'] #);
I've tried changing it to:
%fields = ( ID => [0, 'Link ID:', + 'text'], change_type => [1, 'Type Of Change:', + 'drop'], change_summary => [2, 'Summary Of Change :', + 'text'], machines => [3, 'Machines involved :', + 'drop'], date => [4, 'Date of change:', + 'text'], time => [5, 'Time of change:', + 'text'], change_reason => [6, 'Reason for change:', + 'textarea'] ); %fields_drop = ( #types of system change 'sys' => 'sys', 'ops' => 'ops', 'cmd' => 'cmd');
The code that builds the form is as follows:
sub build_record_page { my (%record) = @_; my ($val) = ""; my ($html) = qq~<TABLE border=1 bgcolor="#FFFFFF" cellspacing=0 cellpa +dding=4> <TR bgcolor="#C0C0C0"> <TD colspan=2><CENTER><font size=-1> Record </CENTER>< +/TD> </TR>~; foreach $obj (@db_fields) { if ($obj eq $db_key) { next; } $html .= qq~<TR bgcolor="#DDDDDD"><TD><FONT SIZE=-1>$d +b_name{$obj}</TD><TD>~; if ($db_type{$obj} eq "text") { # Makes the text box if ($record{$obj}) { $val = qq~ VALUE="$record +{$obj}"~; } else { $val = ""; } $html .= qq~<INPUT TYPE="text" NAME="$obj" siz +e="20" $val>~; } if ($db_type{$obj} eq "drop") { # Makes the dropdown +box if ($record{$obj}) { $val = qq~ VALUE="$record +{$obj}"~; } else { $val = ""; } $html .= qq~<SELECT NAME="$obj +" <option value=""></option> $val>~; # The bit that I am stuck on I n +eed to populate a drop down box from the fields_drop hash, but that n +eeds to depend on which whether it is the type of change, or the mach +ines to which the change will be applied. } elsif ($db_type{$obj} eq "textarea") { # Makes the tex +tarea if ($record{$obj}) { $val = qq~$record{$obj}~; + } else { $val = ""; } $html .= qq~<TEXTAREA NAME="$obj" ROWS="4" COL +S="40">$val</TEXTAREA>~; } $html .= qq~</TD></TR>~; } $html .= "</TABLE><P>"; print $html; }
Can anybody help please?

Replies are listed 'Best First'.
Re: Using drop down boxes in a CGI script
by jethro (Monsignor) on Jul 29, 2008 at 15:09 UTC
    In the tutorial you can read:

    This block of code can look confusing. Remember those variables I declared in the @db_fields area? Well, here they are put to use, such as $db_name (readable version) and $db_type, which determines the input type.

    This is a bit wrong or confusing, because in the code he is using %db_type (i.e. as $db_type{xy}) and not $db_type, but lets hope the code is right.

    So there should be a $db_name{$obj} where you would find the name of your drop down box, either 'Type Of Change:' or 'Machines involved :'

    UPDATE: In the example code $db_name{$obj} is used too, so there definitely IS a $db_name{$obj}.

      I still cannot create a drop down box with this code. Can I use the CGI module with html as well. Can you attach the output HTML from the popup_menu sub in the module CGI to the variable $html. For example I tried the following:
      start_form, $html .= popup_menu ( -name =>'changes', + -values=>\@syschanges); } elsif ($db_type{$obj} eq "textarea") { # Makes the tex +tarea if ($record{$obj}) { $val = qq~$record{$obj}~; + } else { $val = ""; } $html .= qq~<TEXTAREA NAME="$obj" ROWS="4" COL +S="40">$val</TEXTAREA>~; } $html .= qq~</TD></TR>~; } $html .= "</TABLE><P>"; print $html; }
        I can now populate the drop down box with the contents of the array @changetype. All fields are written to the text file, apart from the values in the drop down menu. Does anybody know how I can get those to be written as well?
        This is the whole program so far:
        #!/usr/bin/perl use CGI qw(:standard); %fields = ( ID => [0, 'Link ID:', + 'text'], change_type => [1, 'Type Of Change:', + 'drop'], change_summary => [2, 'Summary Of Change :', + 'text'], machines => [3, 'Machines involved :', + 'text'], date => [4, 'Date of change:', + 'text'], time => [5, 'Time of change:', + 'text'], change_reason => [6, 'Reason for change:', + 'textarea'] ); @changetype = qw/sys ops cmd/; # IF you are not using ID as your key, specify the name here. $db_key = 'ID'; $delimeter = "|"; $file = "./file.cgi"; $numberfile = "./num.cgi"; @db_fields = (); # Holds Specific Field Information foreach $field (sort { $fields{$a}[0] <=> $fields{$b}[0] } keys %field +s) { $db_id{$field} = $fields{$field}[0]; $db_name{$field} = $fields{$field}[1]; $db_type{$field} = $fields{$field}[2]; push @db_fields, $field; } %form = &parse; &print_headers; if ($form{'action'} eq "addrecord") { &add_record; } elsif ($form{'action'} eq "add_record_two") { &add_record_two; } elsif ($form{'action'} eq "edit") { &edit; } elsif ($form{'action'} eq "edit_two") { &edit_two; } elsif ($form{'action'} eq "edit_three") { &edit_three; } elsif ($form{'action'} eq "edit_four") { &edit_four; } elsif ($form{'action'} eq "delete") { &delete_record; } elsif ($form{'action'} eq "delete_two") { &delete_two; } elsif ($form{'action'} eq "delete_three") { &delete_three; } elsif ($form{'action'} eq "search") { &header("Search For Something"); &search_form("search_two"); &footer; } elsif ($form{'action'} eq "search_two") { &search_two; } else { &header("Chgmant v2"); &footer; } sub header { $title = shift; print qq~ <HTML> <HEAD> <TITLE> $title </TITLE> <basefont face="Trebuchet MS,Arial,Helvetica" size="2"> </HEAD> <BODY bgcolor="#FFFFFF"> <CENTER> <H1>CHGMANT V2</H1> ~; } sub footer { print qq~ <TABLE border=0 cellspacing=3 cellpadding=3> <TR> <TD><a href="chgmant_v2.cgi?action=addrecord"><FONT COLOR="#00 +0000" size=-1>Add A Record</a></TD> <TD><a href="chgmant_v2.cgi?action=edit"><FONT COLOR="#000000" + size=-1>Modify a Record</TD> <TD><a href="chgmant_v2.cgi?action=delete"><FONT COLOR="#00000 +0" size=-1>Delete a Record</TD> <TD><a href="chgmant_v2.cgi?action=search"><FONT COLOR="#00000 +0" size=-1>Search</TD> </TR> </TABLE> </CENTER> </BODY> </HTML> ~; } sub build_record_page { my (%record) = @_; my ($val) = ""; my ($html) = qq~<TABLE border=1 bgcolor="#FFFFFF" cellspacing=0 cellpa +dding=4> <TR bgcolor="#C0C0C0"> <TD colspan=2><CENTER><font size=-1> Record </CENTER>< +/TD> </TR>~; foreach $obj (@db_fields) { if ($obj eq $db_key) { next; # ID's are dynamically made, so why let +the user do it? } $html .= qq~<TR bgcolor="#DDDDDD"><TD><FONT SIZE=-1>$d +b_name{$obj}</TD><TD>~; if ($db_type{$obj} eq "text") { # Makes the text box if ($record{$obj}) { $val = qq~ VALUE="$record +{$obj}"~; } else { $val = ""; } $html .= qq~<INPUT TYPE="text" NAME="$obj" siz +e="20" $val>~; } if ($db_type{$obj} eq "drop") { # Makes the dropdown +box if ($record{$obj}) { $val = qq~ VALUE="$record +{$obj}"~; } else { $val = ""; } $html .= start_form $html .= popup_menu ( -name = +>'$obj', -value +s=>\@changetype); } elsif ($db_type{$obj} eq "textarea") { # Makes the tex +tarea if ($record{$obj}) { $val = qq~$record{$obj}~; + } else { $val = ""; } $html .= qq~<TEXTAREA NAME="$obj" ROWS="4" COL +S="40">$val</TEXTAREA>~; } $html .= qq~</TD></TR>~; } $html .= "</TABLE><P>"; print $html; } sub print_headers { # Print out the headers if they haven't already been printed. if (!$headers_printed) { print "Content-type: text/html\n\n"; $headers_printed = 1; } } sub get_next_id { my ($num); open (NUM, $numberfile); $num = <NUM>; close (NUM); $num++; open (NUM, ">".$numberfile); if ($flock) { flock(NUM, 2) } print NUM $num; close (NUM); return $num; } sub process_record { # changes the data format to something we can use my (@array) = @_; my (%record); my ($num) = 0; # map is similar to grep, in that it evaluates each list entry +, and returns the new list with changes made. # this line looks at the available fields in $db_fields, and c +auses the array to go back to a usable # hash format. %record = map { $db_fields[$num] => $array[$num++] } @_; return %record; } sub grab_data { # Takes a record, and grabs it into an array my ($line) = shift; my (@data) = split (/\Q$delimeter\E/o, $line); foreach (@data) { s/``/\n/g; # Change `` back to newlines.. s/~~/$delimeter/g; # get the delimiter back } return @data; } sub get_record { my ($exist) = 0; my ($key) = shift; open(DATA, $file); while (<DATA>) { (/^\s*$/) and next; # Looks for blank lines chomp $_; @record = &grab_data($_); %dat = process_record(@record); if ($dat{$db_key} eq $key) { $exist = 1; last; } } close (DATA); $exist ? return (%dat) : return; } sub make_data { my %record = @_; my ($rec, $line) = ""; foreach $field (@db_fields) { # repeats for all of your configure +d fields $rec = $record{$field}; $rec =~ s/\r//g; # Scrap that Windows Line Feed # This pattern below compiles once, as we dont want an +y weird results. $rec =~ s/\Q$delimeter\E/~~/og; # Scraps the delimeter if us +ed, and makes it ~~ $rec =~ s/\n/``/g; # Grabs Newlines, and makes th +em `` $line .= $rec.$delimeter; # Your Record is Being Made } chop $line; # Whoops... gotta scrap that delimiter at the end (ext +ra one) return $line."\n"; # returns the new record, with the nice shiny l +ine feed } sub add_record { &header("Add a Record"); print qq~ <CENTER> <FORM METHOD=POST> <INPUT TYPE="hidden" NAME="action" VALUE="add_record_two">~; &build_record_page; print qq~ <CENTER> <INPUT TYPE="submit" value="Enter Into Database"></CENTER> <CENTER> </FORM>~; &footer; } sub add_record_two { $form{$db_key} = &get_next_id(); my ($line) = &make_data(%form); open (DATABASE, ">>".$file); if ($flock) { flock(DATABASE, 2) } print DATABASE $line; close (DATABASE); &header("Add a Record Successful"); print qq~<CENTER>Here Is Your Record</CENTER><p>~; my (%result) = get_record($form{$db_key}); if (%result) { &build_record_page(%result); } else { print "Error - No Record Added"; } &footer; } sub search { my (%dat); my ($or_match) = 0; my ($findit,$param) = ""; my @search_terms = (); ($form{'type'} eq 'phrase') ? (@search_terms = ($form{'search_term'})) : (@search_terms = split (/\s/, $form{'search_term'})); if ($form{'boolean'} eq "or") { $or_match = 1;} if ($or_match) { $param = '||' } else { $param = '&&'; } foreach $term (@search_terms) { next if (length($term) < 2); # skips single letter ter +ms if ($form{'field'} eq "everything") { $findit .= "/\Q$term\E/oi $param "; } else { $findit .= "\$dat{\$form{'field'}} =~ /\Q$term +\E/oi $param "; } } chop ($findit); chop ($findit); chop ($findit); $reg = eval "sub { $findit; }"; $@ and print "Error Processing Search" and return; open(DATA, $file); while (<DATA>) { (/^\s*$/) and next; # Looks for blank lines chomp $_; if ($form{'field'} eq "everything") { if (&{$reg}) { push @search_results,$_; } } else { @record = &grab_data($_); %dat = &process_record(@record); if (&{$reg}) { push @search_results,$_; } } } close (DATA); @search_results = &search_sorter(@search_results); return (@search_results); } sub search_sorter { my (@results) = @_; my(@rec); my (%temp_rec,$eval_code); $stop = @db_fields; foreach $result (@results){ (@rec) = &grab_data($result); $eval_code ='$temp_rec{$rec[0]} = { $db_key => "$rec[0]", '; for($i=1;$i<$stop;$i++){ $eval_code .= "\$db_fields[$i] => \"\$rec[$i]\",\n"; } $eval_code .= '};'; eval $eval_code; } $sort_field = $form{'sort_field'}; @results=(); foreach $field (sort { lc($a->{$sort_field}) cmp lc($b->{$sort_field +}) } values %temp_rec){ $new_record = ""; for($i=0;$i<$stop;$i++){ # Now We have to make sure all of our fields are enco +ded again so it looks right $field->{$db_fields[$i]} =~ s/\Q$delimeter\E/~~/og; $field->{$db_fields[$i]} =~ s/\n/``/g; $new_record .= "$field->{$db_fields[$i]}\|"; } chop $new_record; push @results, $new_record; } return (@results); } sub search_two { my (@results) = &search; $search_num = @results; if ($search_num < 1) { &nomatches; } &multi_match_view(@results) if ($search_num > 0); } sub nomatches { my $colspan = @db_fields; &header("No Matches Found For ". $form{'search_term'}) +; print qq~ <CENTER><TABLE border=1 bgcolor="#FFFFFF" cellpadding= +3 cellspacing=0> <TR bgcolor="#C0C0C0"> ~; foreach $field (@db_fields) { print qq~<TD><CENTER><FONT size=-1>$fi +eld</CENTER></TD>~; } print qq~</TR> <TR bgcolor="#DDDDDD"> <TD colspan=~.$colspan.qq~><CENTER><FONT size= +-1><B>No Matches Found For "$form{'search_term'}"</B></CENTER></TD></ +TR></TABLE></CENTER> ~; &footer; } sub multi_match_view { my (@results) = @_; my (%rec); &header($search_num." Matches Found For ". $form{'search_term'}); print qq~ <CENTER><TABLE border=1 bgcolor="#FFFFFF" cellpadding=3 cellspacing=0> <TR bgcolor="#C0C0C0"> ~; foreach $field (@db_fields) { print qq~<TD><CENTER><FONT size=-1>$field</CENTER></TD>~; } print qq~</TR>~; foreach $result (@results) { %rec = &process_record(&grab_data($result)); print qq~<TR bgcolor="#DDDDDD">~; foreach $field (@db_fields) { print qq~<TD><FONT size=-1>~.&nl2br($r +ec{$field}).qq~</TD>~; } print qq~</TR>~; } print qq~</TABLE></CENTER>~; &footer; } sub multi_match { my ($type,$action,$what,@results) = @_; my (%rec); &header($search_num." Matches Found For ". $form{'search_term'}); print qq~ <CENTER><FORM METHOD=POST> <INPUT TYPE="hidden" name="action" value="$action"> <TABLE border=1 bgcolor="#FFFFFF" cellpadding=3 cellspacing=0> <TR bgcolor="#C0C0C0"> <TD><CENTER><FONT size=-1>Select</CENTER></TD> ~; foreach $field (@db_fields) { print qq~<TD><CENTER><FONT size=-1>$field</CENTER></TD>~; } print qq~</TR>~; foreach $result (@results) { %rec = &process_record(&grab_data($result)); print qq~<TR bgcolor="#DDDDDD"><TD><INPUT TYPE="$type" + NAME="key" value="$rec{$db_key}"></TD>~; foreach $field (@db_fields) { print qq~<TD><FONT size=-1>~.&nl2br($r +ec{$field}).qq~</TD>~; } print qq~</TR>~; } print qq~</TABLE><p><INPUT TYPE="submit" value="$what Record(s)"> </FORM></CENTER>~; &footer; } sub edit { &header("Search To Edit"); &search_form("edit_two","To Edit"); &footer; } sub edit_two { my (@results) = &search; $search_num = @results; if ($search_num < 1) { &nomatches; } elsif ($search_num > 0) { &multi_match("radio","edit_three","Edit",@results); } } sub edit_three { &header("Edit Record"); print qq~ <CENTER><TABLE border=1 bgcolor="#FFFFFF" cellpadding=3 cellsp +acing=0> <TR bgcolor="#C0C0C0"><TD> <CENTER> <FORM METHOD=POST> <INPUT TYPE="hidden" NAME="action" VALUE="edit_four"> <INPUT TYPE="hidden" NAME="key" VALUE="$form{'key'}">~; my (%result) = get_record($form{'key'}); if (%result) { &build_record_page(%result); } else { print qq~Error --- Record Does Not Exist ~; } print qq~ <CENTER> <INPUT TYPE="submit" value="Edit Record"></CENTER> <CENTER> </FORM></TD></TR></TABLE></CENTER>~; &footer; } sub edit_four { $form{$db_key} = $form{'key'}; my ($line) = &make_data(%form); my ($found) = 0; my ($output) = ""; open (DATABASE, $file); while (<DATABASE>) { chomp($_); (/^\s*$/) and next; my (%dat) = &process_record(&grab_data($_)); if ($dat{$db_key} eq $form{'key'}) { $output .= $line; $found = 1; } else { $output .= "$_\n"; } } close (DATABASE); if ($found) { open (DATABASE, ">".$file); if ($flock) { flock(DATABASE, 2); } print DATABASE $output; close (DATABASE); } &header("Record Edited Successful"); print qq~<CENTER>Here Is Your Record<p>~; my (%result) = get_record($form{'key'}); if (%result) { &build_record_page(%result); } else { print "Error - No Record Added"; } print qq~</CENTER>~; &footer; } sub delete_record { &header("Search To Delete"); &search_form("delete_two","To Delete"); &footer; } sub delete_two { my (@results) = &search; $search_num = @results; if ($search_num < 1) { &nomatches; } elsif ($search_num > 0) { &multi_match("checkbox","delete_three","Delete",@results); } } sub delete_three { my (@keys) = split (/,/,$form{'key'}); my ($output) = ""; my ($found) = 0; open (DATABASE, $file); while (<DATABASE>) { chomp($_); (/^\s*$/) and next; my (%dat) = &process_record(&grab_data($_)); foreach $key (@keys) { if ($dat{$db_key} eq $key) { $found = 1; } } if ($found) { $found = 0; next; } else { $output .= "$_\n"; } } close (DATABASE); open (DATABASE, ">".$file); if ($flock) { flock(DATABASE, 2); } print DATABASE $output; close (DATABASE); &header("Record Edited Successful"); print qq~<CENTER><font size=-1>Record(s) Deleted></CENTER>~; &footer; } sub search_form { $action_val = shift; $text = shift; my ($check) = ""; print qq~ <FORM METHOD=post> <INPUT TYPE="hidden" NAME="action" VALUE="$action_val"> <TABLE border=1 bgcolor="#FFFFFF" cellspacing=0 cellpadding=4> <TR bgcolor="#C0C0C0"> <TD colspan=2><CENTER><font size=-1> Search For a Reco +rd $text </CENTER></TD> </TR> <TR bgcolor="#DDDDDD"> <TD><font size=-1>Search Term </TD> <TD><font size=-1><INPUT TYPE="text" NAME="search_term +" size=20>&nbsp;&nbsp;Type <INPUT TYPE="radio" NAME="type" value="phr +ase">Phrase&nbsp;&nbsp;<INPUT TYPE="radio" NAME="type" value="keyword +s" CHECKED>Keywords</TD> </TR> <TR bgcolor="#DDDDDD"> <TD><font size=-1>Boolean Connector</TD> <TD><font size=-1>&nbsp;&nbsp;<INPUT TYPE="radio" NAME +="boolean" value="and" CHECKED>AND&nbsp;&nbsp;<INPUT TYPE="radio" NAM +E="boolean" value="or">OR</TD> </TR> <TR bgcolor="#DDDDDD"> <TD><font size=-1>Search Fields</TD> <TD> <font size=-1>All: <INPUT TYPE="radio" NAME="field" va +lue="everything" CHECKED>~; foreach $field (@db_fields) { if ($field eq $db_key) { next; } print qq~&nbsp;&nbsp;$db_name{$field}<INPUT TYPE="radi +o" NAME="field" value="$field"> ~; } print qq~</TD></TR> <TR bgcolor="#DDDDDD"> <TD><font size=-1>Sort By</TD> <TD>~; foreach $field (@db_fields) { if ($field eq "ID") { $val = " CHECKED"; } else { $val + = "" }; print qq~<font size=-1>&nbsp;&nbsp;$db_name{$field}<IN +PUT TYPE="radio" NAME="sort_field" value="$field"$val> ~; } print qq~</TD></TR></TABLE>~; print qq~<CENTER><INPUT TYPE="submit" value="Search"></CENTER> +</FORM>~; } sub nl2br { #changes newlines to <br>'s my ($tmp) = shift; $tmp =~ s/\n/\n<br>/g; return ($tmp); } sub parse { my (%temp); (*fval) = @_ if @_ ; local ($buf); if ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN,$buf,$ENV{' +CONTENT_LENGTH'}); } else { $buf=$ENV{'QUERY_STRING'}; } if ($buf eq "") { return 0 ; } else { @fval=split(/&/,$buf); foreach $i (0 .. $#fval) { ($name,$val)=split (/=/,$fval[$i],2); $val=~tr/+/ /; $val=~ s/%(..)/pack("c",hex($1))/ge; $name=~tr/+/ /; $name=~ s/%(..)/pack("c",hex($1))/ge; if (!defined($temp{$name})) { $temp{$name}=$va +l; } else { $temp{$name} .= ",$val"; } } } return (%temp); }
Re: Using drop down boxes in a CGI script
by Anonymous Monk on Jul 29, 2008 at 14:08 UTC
    The bit that I am stuck on I need to populate a drop down box from the fields_drop hash, but that needs to depend on which whether it is the type of change, or the machines to which the change will be applied.
    You need to explain this better, perhaps with sample input, expected output.