[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.108, Thu Feb 14 19:13:33 2008 UTC revision 1.109, Sun Mar 23 16:32:05 2008 UTC
# Line 14  Line 14 
14      use BasicLocation;      use BasicLocation;
15      use CustomAttributes;      use CustomAttributes;
16      use RemoteCustomAttributes;      use RemoteCustomAttributes;
17        use CGI;
18      use base qw(ERDB);      use base qw(ERDB);
19    
20  =head1 Sprout Database Manipulation Object  =head1 Sprout Database Manipulation Object
# Line 465  Line 466 
466      return $retVal;      return $retVal;
467  }  }
468    
469  =head3 GeneMenu  =head3 GenomeMenu
470    
471      my $selectHtml = $sprout->GeneMenu(\%attributes, $filterString, \@params, $selected);      my $html = $sprout->GenomeMenu(%options);
472    
473  Return an HTML select menu of genomes. Each genome will be an option in the menu,  Generate a genome selection control with the specified name and options.
474  and will be displayed by name with the ID and a contig count attached. The selection  This control is almost but not quite the same as the genome control in the
475  value will be the genome ID. The genomes will be sorted by genus/species name.  B<SearchHelper> class. Eventually, the two will be combined.
476    
477  =over 4  =over 4
478    
479  =item attributes  =item options
480    
481    Optional parameters for the control (see below).
482    
483  Reference to a hash mapping attributes to values for the SELECT tag generated.  =item RETURN
484    
485  =item filterString  Returns the HTML for a genome selection control on a form (sometimes called a popup menu).
486    
487  A filter string for use in selecting the genomes. The filter string must conform  =back
 to the rules for the C<< ERDB->Get >> method.  
488    
489  =item params  The valid options are as follows.
490    
491  Reference to a list of values to be substituted in for the parameter marks in  =over 4
 the filter string.  
492    
493  =item selected (optional)  =item name
494    
495  ID of the genome to be initially selected.  Name to give this control for use in passing it to the form. The default is C<myGenomeControl>.
496    Terrible things will happen if you have two controls with the same name on the same page.
497    
498  =item fast (optional)  =item filter
499    
500  If specified and TRUE, the contig counts will be omitted to improve performance.  If specified, a filter for the list of genomes to display. The filter should be in the form of a
501    list reference. The first element of the list should be the filter string, and the remaining elements
502    the filter parameters.
503    
504  =item RETURN  =item multiSelect
505    
506    If TRUE, then the user can select multiple genomes. If FALSE, the user can only select one genome.
507    
508    =item size
509    
510    Number of rows to display in the control. The default is C<10>
511    
512    =item id
513    
514    ID to give this control. The default is the value of the C<name> option. Nothing will work correctly
515    unless this ID is unique.
516    
517    =item selected
518    
519  Returns an HTML select menu with the specified genomes as selectable options.  A comma-delimited list of selected genomes, or a reference to a list of selected genomes. The
520    default is none.
521    
522    =item inTable
523    
524    If TRUE, then backslashes will be included at the end of each line in the resulting HTML. This enables the control
525    to be used in TWiki tables.
526    
527  =back  =back
528    
529  =cut  =cut
530    
531  sub GeneMenu {  sub GenomeMenu {
532      # Get the parameters.      # Get the parameters.
533      my ($self, $attributes, $filterString, $params, $selected, $fast) = @_;      my ($self, %options) = @_;
534      my $slowMode = ! $fast;      # Get the control's name and ID.
535      # Default to nothing selected. This prevents an execution warning if "$selected"      my $menuName = $options{name} || 'myGenomeControl';
536      # is undefined.      my $menuID = $options{id} || $menuName;
537      $selected = "" unless defined $selected;      # Compute the IDs for the status display.
538      Trace("Gene Menu called with slow mode \"$slowMode\" and selection \"$selected\".") if T(3);      my $divID = "${menuID}_status";
539      # Start the menu.      my $urlID = "${menuID}_url";
540      my $retVal = "<select " .      # Compute the code to show selected genomes in the status area.
541          join(" ", map { "$_=\"$attributes->{$_}\"" } keys %{$attributes}) .      my $showSelect = "showSelected('$menuID', '$divID', '$urlID', 1000)";
542          ">\n";      # Check for single-select or multi-select.
543      # Get the genomes.      my $multiSelect = $options{multiSelect} || 0;
544      my @genomes = $self->GetAll(['Genome'], $filterString, $params, ['Genome(id)',      # Get the list of pre-selected items.
545                                                                       'Genome(genus)',      my $selections = $options{selected} || [];
546                                                                       'Genome(species)',      if (ref $selections ne 'ARRAY') {
547                                                                       'Genome(unique-characterization)']);          $selections = [ split /\s*,\s*/, $selections ];
548      # Sort them by name.      }
549      my @sorted = sort { lc("$a->[1] $a->[2]") cmp lc("$b->[1] $b->[2]") } @genomes;      my %selected = map { $_ => } @{$selections};
550      # Loop through the genomes, creating the option tags.      # Extract the filter information. The default is no filtering. It can be passed as a tab-delimited
551      for my $genomeData (@sorted) {      # string or a list reference.
552          # Get the data for this genome.      my $filterParms = $options{filter} || "";
553          my ($genomeID, $genus, $species, $strain) = @{$genomeData};      if (! ref $filterParms) {
554          # Get the contig count.          $filterParms = [split /\t|\\t/, $filterParms];
555          my $contigInfo = "";      }
556          if ($slowMode) {      my $filterString = shift @{$filterParms};
557              my $count = $self->ContigCount($genomeID);      # Get a list of all the genomes in group order. In fact, we only need them ordered
558              my $counting = ($count == 1 ? "contig" : "contigs");      # by name (genus,species,strain), but putting primary-group in front enables us to
559              $contigInfo = "[$count $counting]";      # take advantage of an existing index.
560          }      my @genomeList = $self->GetAll(['Genome'], "$filterString ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",
561          # Find out if we're selected.                                     $filterParms,
562          my $selectOption = ($selected eq $genomeID ? " selected" : "");                                     [qw(Genome(primary-group) Genome(id) Genome(genus) Genome(species) Genome(unique-characterization) Genome(taxonomy) Genome(contigs))]);
563          # Build the option tag.      # Create a hash to organize the genomes by group. Each group will contain a list of
564          $retVal .= "<option value=\"$genomeID\"$selectOption>$genus $species $strain ($genomeID)$contigInfo</option>\n";      # 2-tuples, the first element being the genome ID and the second being the genome
565        # name.
566        my %gHash = ();
567        for my $genome (@genomeList) {
568            # Get the genome data.
569            my ($group, $genomeID, $genus, $species, $strain, $taxonomy, $contigs) = @{$genome};
570            # Compute its name. This is the genus, species, strain (if any), and the contig count.
571            my $name = "$genus $species ";
572            $name .= "$strain " if $strain;
573            my $contigCount = ($contigs == 1 ? "" : ", $contigs contigs");
574            # Now we get the domain. The domain tells us the display style of the organism.
575            my ($domain) = split /\s*;\s*/, $taxonomy, 2;
576            # Now compute the display group. This is normally the primary group, but if the
577            # organism is supporting, we blank it out.
578            my $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
579            # Push the genome into the group's list. Note that we use the real group
580            # name for the hash key here, not the display group name.
581            push @{$gHash{$group}}, [$genomeID, $name, $contigCount, $domain];
582        }
583        # We are almost ready to unroll the menu out of the group hash. The final step is to separate
584        # the supporting genomes by domain. First, we extract the NMPDR groups and sort them. They
585        # are sorted by the first capitalized word. Groups with "other" are sorted after groups
586        # that aren't "other". At some point, we will want to make this less complicated.
587        my %sortGroups = map { $_ =~ /(other)?(.*)([A-Z].+)/; "$3$1$2" => $_ }
588                             grep { $_ ne $FIG_Config::otherGroup } keys %gHash;
589        my @groups = map { $sortGroups{$_} } sort keys %sortGroups;
590        # Remember the number of NMPDR groups.
591        my $nmpdrGroupCount = scalar @groups;
592        # Loop through the supporting genomes, classifying them by domain. We'll also keep a list
593        # of the domains found.
594        my @otherGenomes = @{$gHash{$FIG_Config::otherGroup}};
595        my @domains = ();
596        for my $genomeData (@otherGenomes) {
597            my ($genomeID, $name, $contigCount, $domain) = @{$genomeData};
598            if (exists $gHash{$domain}) {
599                push @{$gHash{$domain}}, $genomeData;
600            } else {
601                $gHash{$domain} = [$genomeData];
602                push @domains, $domain;
603            }
604        }
605        # Add the domain groups at the end of the main group list. The main group list will now
606        # contain all the categories we need to display the genomes.
607        push @groups, sort @domains;
608        # Delete the supporting group.
609        delete $gHash{$FIG_Config::otherGroup};
610        # Now it gets complicated. We need a way to mark all the NMPDR genomes. We take advantage
611        # of the fact they come first in the list. We'll accumulate a count of the NMPDR genomes
612        # and use that to make the selections.
613        my $nmpdrCount = 0;
614        # Create the type counters.
615        my $groupCount = 1;
616        # Get the number of rows to display.
617        my $rows = $options{size} || 10;
618        # If we're multi-row, create an onChange event.
619        my $onChangeTag = ( $rows > 1 ? " onChange=\"$showSelect;\" onFocus=\"$showSelect;\"" : "" );
620        # Set up the multiple-select flag.
621        my $multipleTag = ($multiSelect ? " multiple" : "" );
622        # Create the SELECT tag and stuff it into the output array.
623        my @lines = ("<SELECT name=\"$menuID\" id=\"$menuID\" $onChangeTag$multipleTag size=\"$rows\" style=\"width: 100%\">");
624        # Loop through the groups.
625        for my $group (@groups) {
626            # Get the genomes in the group.
627            for my $genome (@{$gHash{$group}}) {
628                # If this is an NMPDR organism, we add an extra style and count it.
629                my $nmpdrStyle = "";
630                if ($nmpdrGroupCount > 0) {
631                    $nmpdrCount++;
632                    $nmpdrStyle = " Core";
633                }
634                # Get the organism ID, name, contig count, and domain.
635                my ($genomeID, $name, $contigCount, $domain) = @{$genome};
636                # See if we're pre-selected.
637                my $selectTag = ($selected{$genomeID} ? " SELECTED" : "");
638                # Compute the display name.
639                my $nameString = "$name ($genomeID$contigCount)";
640                # Generate the option tag.
641                my $optionTag = "<OPTION class=\"$domain$nmpdrStyle\" title=\"$group\" value=\"$genomeID\"$selectTag>$nameString</OPTION>";
642                push @lines, "    $optionTag";
643            }
644            # Record this group in the nmpdrGroup count. When that gets to 0, we've finished the NMPDR
645            # groups.
646            $nmpdrGroupCount--;
647      }      }
648      # Close the SELECT tag.      # Close the SELECT tag.
649      $retVal .= "</select>\n";      push @lines, "</SELECT>";
650        if ($rows > 1) {
651            # We're in a non-compact mode, so we need to add some selection helpers. First is
652            # the search box. This allows the user to type text and change which genomes are
653            # displayed. For multiple-select mode, we include a button that selects the displayed
654            # genes. For single-select mode, we use a plain label instead.
655            my $searchThingName = "${menuID}_SearchThing";
656            my $searchThingLabel = ($multiSelect ? "<INPUT type=\"button\" name=\"MacroSearch\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectShowing('$menuID', '$searchThingName'); $showSelect;\" />"
657                                                 : "Show genomes containing");
658            push @lines, "<br />$searchThingLabel&nbsp;" .
659                         "<INPUT type=\"text\" id=\"$searchThingName\" name=\"$searchThingName\" size=\"30\" onKeyup=\"showTyped('$menuID', '$searchThingName');\" />";
660            # For multi-select mode, we also have buttons to set and clear selections.
661            if ($multiSelect) {
662                push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll('$menuID'); $showSelect\" />";
663                push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll('$menuID'); $showSelect\" />";
664                push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome('$menuID', $nmpdrCount, true); $showSelect;\" />";
665            }
666            # Add a hidden field we can use to generate organism page hyperlinks.
667            push @lines, "<INPUT type=\"hidden\" id=\"$urlID\" value=\"$FIG_Config::cgi_url/seedviewer.cgi?page=Organism;organism=\" />";
668            # Add the status display. This tells the user what's selected no matter where the list is scrolled.
669            push @lines, "<DIV id=\"$divID\" class=\"Panel\"></DIV>";
670        }
671        # Assemble all the lines into a string. This is where we do the "inTable" thing to insure we don't mess up TWiki tables.
672        my $delim = ($options{inTable} ? "\\" : "" ) . "\n";
673        my $retVal = join($delim, @lines, "");
674      # Return the result.      # Return the result.
675      return $retVal;      return $retVal;
676  }  }
677    
678    
679  =head3 Build  =head3 Build
680    
681      $sprout->Build();      $sprout->Build();

Legend:
Removed from v.1.108  
changed lines
  Added in v.1.109

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3