[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.124, Wed Mar 4 00:09:43 2009 UTC revision 1.126, Thu Apr 2 01:47:00 2009 UTC
# Line 299  Line 299 
299                  $retVal = $superGroup;                  $retVal = $superGroup;
300              }              }
301          }          }
         # Make sure we found something.  
         if (! $retVal) {  
             Confess("No super-group found for \"$groupName\".");  
         }  
302      }      }
303      # Return the result.      # Return the result.
304      return $retVal;      return $retVal;
# Line 726  Line 722 
722          my $searchThingName = "${menuID}_SearchThing";          my $searchThingName = "${menuID}_SearchThing";
723          my $searchThingLabel = "Type to narrow selection";          my $searchThingLabel = "Type to narrow selection";
724          my $searchThingButton = "";          my $searchThingButton = "";
         my $goHint = "";  
725          if ($multiSelect) {          if ($multiSelect) {
726              $searchThingButton = qq(<INPUT type="button" name="MacroSearch" class="button" value="Go" onClick="selectShowing('$menuID', '$searchThingName'); $showSelect;" />);              $searchThingButton = qq(<INPUT type="button" name="MacroSearch" class="button" value="Go" onClick="selectShowing('$menuID', '$searchThingName'); $showSelect;" />);
             $goHint = " Click <strong>Go</strong> to select them.";  
727          }          }
728          push @lines, "<br />$searchThingLabel&nbsp;" .          push @lines, "<br />$searchThingLabel&nbsp;" .
729                       qq(<INPUT type="text" id="$searchThingName" name="$searchThingName" class="genomeSearchThing" onKeyup="showTyped('$menuID', '$searchThingName');" />) .                       qq(<INPUT type="text" id="$searchThingName" name="$searchThingName" class="genomeSearchThing" onKeyup="showTyped('$menuID', '$searchThingName');" />) .
730                       $searchThingButton .                       $searchThingButton .
731                       Hint("GenomeControl", "Type a genome ID or part of an organism name to filter the genomes displayed.$goHint") . "<br />";                       Hint("GenomeControl", 28) . "<br />";
732          # For multi-select mode, we also have buttons to set and clear selections.          # For multi-select mode, we also have buttons to set and clear selections.
733          if ($multiSelect) {          if ($multiSelect) {
734              push @lines, qq(<INPUT type="button" name="ClearAll" class="bigButton genomeButton" value="Clear All" onClick="clearAll(getElementById('$menuID')); $showSelect" />);              push @lines, qq(<INPUT type="button" name="ClearAll" class="bigButton genomeButton" value="Clear All" onClick="clearAll(getElementById('$menuID')); $showSelect" />);
# Line 752  Line 746 
746      return $retVal;      return $retVal;
747  }  }
748    
749    =head3 Cleanup
750    
751        $sprout->Cleanup();
752    
753    Release the internal cache structures to free up memory.
754    
755    =cut
756    
757    sub Cleanup {
758        # Get the parameters.
759        my ($self) = @_;
760        # Delete the stemmer.
761        delete $self->{stemmer};
762        # Delete the attribute database.
763        delete $self->{_ca};
764        # Delete the group hash.
765        delete $self->{groupHash};
766        # Is there a FIG object?
767        if (defined $self->{fig}) {
768            # Yes, clear its subsystem cache.
769            $self->{fig}->clear_subsystem_cache();
770        }
771    }
772    
773    
774  =head3 Stem  =head3 Stem
775    
# Line 1006  Line 1024 
1024  }  }
1025    
1026    
   
1027  =head3 PointLocation  =head3 PointLocation
1028    
1029      my $found = Sprout::PointLocation($location, $point);      my $found = Sprout::PointLocation($location, $point);
# Line 3985  Line 4002 
4002    
4003  =over 4  =over 4
4004    
4005  =item page  =item specials
4006    
4007  The super-group's web page in the NMPDR.  Reference to a hash whose keys are the names of special species.
4008    
4009  =item contents  =item contents
4010    
# Line 4010  Line 4027 
4027          my @groupLines = Tracer::GetFile("$FIG_Config::sproutData/groups.tbl");          my @groupLines = Tracer::GetFile("$FIG_Config::sproutData/groups.tbl");
4028          # Loop through the list of sort-of groups.          # Loop through the list of sort-of groups.
4029          for my $groupLine (@groupLines) {          for my $groupLine (@groupLines) {
4030              my ($name, $page, @contents) = split /\t/, $groupLine;              my ($name, $specials, @contents) = split /\t/, $groupLine;
4031              $groupHash{$name} = { page => $page,              $groupHash{$name} = { specials => { map { $_ => 1 } split /\s*,\s*/, $specials },
4032                                    contents => [ map { [ split /\s*,\s*/, $_ ] } @contents ]                                    contents => [ map { [ split /\s*,\s*/, $_ ] } @contents ]
4033                                  };                                  };
4034          }          }
# Line 4072  Line 4089 
4089  sub GetSourceObject {  sub GetSourceObject {
4090      # Get the parameters.      # Get the parameters.
4091      my ($self) = @_;      my ($self) = @_;
4092      # Check to see if we already have a source object.      # Do we already have one?
4093      my $retVal = $self->{_fig};      my $retVal = $self->{fig};
4094      if (! defined $retVal) {      if (! defined $retVal) {
4095          # No, so create one.          # Create the object.
4096          require FIG;          require FIG;
4097          $retVal = FIG->new();          $retVal = FIG->new();
4098            Trace("FIG source object created for process $$.") if T(ERDBLoadGroup => 3);
4099            # Set up retries to prevent the lost-connection error when harvesting
4100            # the feature data.
4101            my $dbh = $retVal->db_handle();
4102            $dbh->set_retries(5);
4103            # Save it for other times.
4104            $self->{fig} = $retVal;
4105      }      }
4106      # Return the object.      # Return the object.
4107      return $retVal;      return $retVal;
# Line 4085  Line 4109 
4109    
4110  =head3 SectionList  =head3 SectionList
4111    
4112      my @sections = $erdb->SectionList();      my @sections = $erdb->SectionList($fig);
4113    
4114  Return a list of the names for the different data sections used when loading this database.  Return a list of the names for the different data sections used when loading this database.
4115  The default is a single string, in which case there is only one section representing the  The default is a single string, in which case there is only one section representing the
# Line 4098  Line 4122 
4122      my ($self, $source) = @_;      my ($self, $source) = @_;
4123      # Ask the BaseSproutLoader for a section list.      # Ask the BaseSproutLoader for a section list.
4124      require BaseSproutLoader;      require BaseSproutLoader;
4125      my @retVal = BaseSproutLoader::GetSectionList($self);      my @retVal = BaseSproutLoader::GetSectionList($self, $source);
4126      # Return the list.      # Return the list.
4127      return @retVal;      return @retVal;
4128  }  }
# Line 4159  Line 4183 
4183    
4184  sub LoadGroupList {  sub LoadGroupList {
4185      # Return the list.      # Return the list.
4186      return qw(Genome Subsystem Annotation Property Source Reaction Synonym Feature Drug);      return qw(Feature Subsystem Genome Annotation Property Source Reaction Synonym Drug);
4187  }  }
4188    
4189  =head3 LoadDirectory  =head3 LoadDirectory
# Line 4326  Line 4350 
4350    
4351  =head3 Hint  =head3 Hint
4352    
4353      my $htmlText = SearchHelper::Hint($wikiPage, $hintText);      my $htmlText = Sprout::Hint($wikiPage, $hintID);
4354    
4355  Return the HTML for a small question mark that displays the specified hint text when it is clicked.  Return the HTML for a help link that displays the specified hint text when it is clicked.
4356  This HTML can be put in forms to provide a useful hinting mechanism.  This HTML can be put in forms to provide a useful hinting mechanism.
4357    
4358  =over 4  =over 4
# Line 4337  Line 4361 
4361    
4362  Name of the wiki page to be popped up when the hint mark is clicked.  Name of the wiki page to be popped up when the hint mark is clicked.
4363    
4364  =item hintText  =item hintID
4365    
4366  Text to display for the hint. It is raw html, but may not contain any double quotes.  ID of the text to display for the hint. This should correspond to a tip number
4367    in the Wiki.
4368    
4369  =item RETURN  =item RETURN
4370    
4371  Returns the html for the hint facility. The resulting html shows a small button-like thing that  Returns the html for the hint facility. The resulting html shows the word "help" and
4372  uses the standard FIG popup technology.  uses the standard FIG popup technology.
4373    
4374  =back  =back
# Line 4352  Line 4377 
4377    
4378  sub Hint {  sub Hint {
4379      # Get the parameters.      # Get the parameters.
4380      my ($wikiPage, $hintText) = @_;      my ($wikiPage, $hintID) = @_;
4381      # Escape the single quotes in the hint text.      # Declare the return variable.
4382      my $quotedText = $hintText;      my $retVal;
     $quotedText =~ s/'/\\'/g;  
4383      # Convert the wiki page name to a URL.      # Convert the wiki page name to a URL.
4384      my $wikiURL = join("", map { ucfirst $_ } split /\s+/, $wikiPage);      my $wikiURL;
4385      $wikiURL = "$FIG_Config::cgi_url/wiki/view.cgi/FIG/$wikiURL";      if ($wikiPage =~ m#/#) {
4386      # Compute the mouseover script.          # Here it's a URL of some sort.
4387      my $mouseOver = "doTooltip(this, '$quotedText')";          $wikiURL = $wikiPage;
4388      # Create the html.      } else {
4389      my $retVal = "&nbsp;<a href=\"$wikiURL\"><img src=\"$FIG_Config::cgi_url/Html/button-h.png\" class=\"helpicon\" onmouseover=\"$mouseOver\"/></a>";          # Here it's a wiki page.
4390      # Return it.          my $page = join("", map { ucfirst $_ } split /\s+/, $wikiPage);
4391            if ($page =~ /^(.+?)\.(.+)$/) {
4392                $page = "$1/$2";
4393            } else {
4394                $page = "FIG/$page";
4395            }
4396            $wikiURL = "$FIG_Config::cgi_url/wiki/view.cgi/$page";
4397        }
4398        # Is there hint text?
4399        if (! $hintID) {
4400            # No. Create a new-page hint.
4401            $retVal = qq(&nbsp;<a class="hint" onclick="doPagePopup(this, '$wikiURL')">(help)</a>);
4402        } else {
4403            # With hint text, we create a popup window hint. We need to compute the hint URL.
4404            my $tipURL = "$FIG_Config::cgi_url/wiki/view.cgi/FIG/TWikiCustomTip" .
4405                Tracer::Pad($hintID, 3, 1, "0");
4406            # Create a hint pop-up link.
4407            $retVal = qq(&nbsp;<a class="hint" onclick="doHintPopup(this, '$wikiURL', '$tipURL')">(help)</a>);
4408        }
4409        # Return the HTML.
4410      return $retVal;      return $retVal;
4411  }  }
4412    

Legend:
Removed from v.1.124  
changed lines
  Added in v.1.126

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3