[Bio] / Sprout / Sprout.pm Repository:
ViewVC logotype

Diff of /Sprout/Sprout.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.85, Tue Sep 19 00:14:04 2006 UTC revision 1.86, Sun Sep 24 17:14:16 2006 UTC
# Line 438  Line 438 
438      $self->CreateTables();      $self->CreateTables();
439  }  }
440    
441    =head3 NmpdrGenomeMenu
442    
443    C<< my $htmlText = $sprout->NmpdrGenomeMenu(\%options, \@selected); >>
444    
445    This method creates a hierarchical HTML menu for NMPDR genomes organized by category. The
446    category indicates the low-level NMPDR group. Organizing the genomes in this way makes it
447    easier to select all genomes from a particular category.
448    
449    =over 4
450    
451    =item options
452    
453    Reference to a hash containing the options to be applied to the C<SELECT> tag form the menu.
454    Typical options would include C<name> to specify the field name, C<multiple> to specify
455    that multiple selections are allowed, and C<size> to set the number of rows to display
456    in the menu.
457    
458    =item selected
459    
460    Reference to a list containing the IDs of the genomes to be pre-selected. If the menu
461    is not intended to allow multiple selections, the list should be a singleton. If the
462    list is empty, nothing will be pre-selected.
463    
464    =item RETURN
465    
466    Returns the HTML text to generate a C<SELECT> menu inside a form.
467    
468    =back
469    
470    =cut
471    
472    sub NmpdrGenomeMenu {
473        # Get the parameters.
474        my ($self, $options, $selected) = @_;
475        # Get a list of all the genomes in group order. In fact, we only need them ordered
476        # by name (genus,species,strain), but putting primary-group in front enables us to
477        # take advantage of an existing index.
478        my @genomeList = $self->GetAll(['Genome'],
479                                       "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",
480                                       [], ['Genome(primary-group)', 'Genome(id)',
481                                            'Genome(genus)', 'Genome(species)',
482                                            'Genome(unique-characterization)']);
483        # Create a hash to organize the genomes by group. Each group will contain a list of
484        # 2-tuples, the first element being the genome ID and the second being the genome
485        # name.
486        my %groupHash = ();
487        for my $genome (@genomeList) {
488            # Get the genome data.
489            my ($group, $genomeID, $genus, $species, $strain) = @{$genome};
490            # Form the genome name.
491            my $name = "$genus $species";
492            if ($strain) {
493                $name .= " $strain";
494            }
495            # Push the genome into the group's list.
496            push @{$groupHash{$group}}, [$genomeID, $name];
497        }
498        # Now we are ready to unroll the menu out of the group hash. First, we sort the groups, putting
499        # the supporting-genome group last.
500        my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %groupHash;
501        push @groups, $FIG_Config::otherGroup;
502        # Next, create a hash that specifies the pre-selected entries.
503        my %selectedHash = map { $_ => 1 } @{$selected};
504        # Create the SELECT tag and stuff it into the output array.
505        my $select = "<" . join(" ", 'SELECT', map { "$_=\"$options->{$_}\"" } keys %{$options}) . ">";
506        my @lines = ($select);
507        # Loop through the groups.
508        for my $group (@groups) {
509            # Create the option group tag.
510            my $tag = "<OPTGROUP name=\"$group\">";
511            push @lines, "  $tag";
512            # Get the genomes in the group.
513            for my $genome (@{$groupHash{$group}}) {
514                my ($genomeID, $name) = @{$genome};
515                # See if it's selected.
516                my $select = ($selectedHash{$genomeID} ? " selected" : "");
517                # Generate the option tag.
518                my $optionTag = "<OPTION value=\"$genomeID\"$select>$name</OPTION>";
519                push @lines, "    $optionTag";
520            }
521            # Close the option group.
522            push @lines, "  </OPTGROUP>";
523        }
524        # Close the SELECT tag.
525        push @lines, "</SELECT>";
526        # Assemble the lines into a string.
527        my $retVal = join("\n", @lines, "");
528        # Return the result.
529        return $retVal;
530    }
531    
532  =head3 Genomes  =head3 Genomes
533    
534  C<< my @genomes = $sprout->Genomes(); >>  C<< my @genomes = $sprout->Genomes(); >>
# Line 3274  Line 3365 
3365          # Here we have a group list. Loop through them individually,          # Here we have a group list. Loop through them individually,
3366          # getting a list of the relevant genomes.          # getting a list of the relevant genomes.
3367          for my $group (@{$groupList}) {          for my $group (@{$groupList}) {
3368              my @genomeIDs = $self->GetFlat(['Genome'], "Genome(group-name) = ?",              my @genomeIDs = $self->GetFlat(['Genome'], "Genome(primary-group) = ?",
3369                  [$group], "Genome(id)");                  [$group], "Genome(id)");
3370              $retVal{$group} = \@genomeIDs;              $retVal{$group} = \@genomeIDs;
3371          }          }
# Line 3282  Line 3373 
3373          # Here we need all of the groups. In this case, we run through all          # Here we need all of the groups. In this case, we run through all
3374          # of the genome records, putting each one found into the appropriate          # of the genome records, putting each one found into the appropriate
3375          # group. Note that we use a filter clause to insure that only genomes          # group. Note that we use a filter clause to insure that only genomes
3376          # in groups are included in the return set.          # in real NMPDR groups are included in the return set.
3377          my @genomes = $self->GetAll(['Genome'], "Genome(group-name) > ' '", [],          my @genomes = $self->GetAll(['Genome'], "Genome(primary-group) <> ?",
3378                                      ['Genome(id)', 'Genome(group-name)']);                                      [$FIG_Config::otherGroup], ['Genome(id)', 'Genome(primary-group)']);
3379          # Loop through the genomes found.          # Loop through the genomes found.
3380          for my $genome (@genomes) {          for my $genome (@genomes) {
3381              # Pop this genome's ID off the current list.              # Pop this genome's ID off the current list.

Legend:
Removed from v.1.85  
changed lines
  Added in v.1.86

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3