[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.123, Fri Jan 23 13:44:51 2009 UTC revision 1.128, Tue Jun 30 19:53:01 2009 UTC
# Line 45  Line 45 
45    
46  =head3 new  =head3 new
47    
48      my $sprout = Sprout->new($dbName, \%options);      my $sprout = Sprout->new(%parms)
49    
50  This is the constructor for a sprout object. It connects to the database and loads the  This is the constructor for a sprout object. It connects to the database and loads the
51  database definition into memory. The positional first parameter specifies the name of the  database definition into memory. The incoming parameter hash has the following permissible
52  database.  members (others will be ignored without error.
53    
54  =over 4  =over 4
55    
56    =item DBD
57    
58    Name of the XML file containing the database definition (default C<SproutDBD.xml> in
59    the DBD directory).
60    
61  =item dbName  =item dbName
62    
63  Name of the database. If omitted, the default Sprout database name is used.  Name of the database. If omitted, the default Sprout database name is used.
64    
65  =item options  =item options
66    
67  Table of options.  Sub-hash of special options.
68    
69  * B<dbType> type of database (currently C<mysql> for MySQL and C<pg> for PostgreSQL) (default C<mysql>)  * B<dbType> type of database (currently C<mysql> for MySQL and C<pg> for PostgreSQL) (default C<mysql>)
70    
71  * B<dataDir> directory containing the database definition file and the flat files used to load the data (default C<Data>)  * B<dataDir> directory containing the database definition file and the flat files used to load the data (default C<Data>)
72    
 * B<xmlFileName> name of the XML file containing the database definition (default C<SproutDBD.xml>)  
   
73  * B<userData> user name and password, delimited by a slash (default same as SEED)  * B<userData> user name and password, delimited by a slash (default same as SEED)
74    
75  * B<port> connection port (default C<0>)  * B<port> connection port (default C<0>)
# Line 87  Line 90 
90  I<fig> with a password of I<admin>. The database load files are in the directory  I<fig> with a password of I<admin>. The database load files are in the directory
91  F</usr/fig/SproutData>.  F</usr/fig/SproutData>.
92    
93      my $sprout = Sprout->new('Sprout', { userData => 'fig/admin', dataDir => '/usr/fig/SproutData' });      my $sprout = Sprout->new(dbName => 'Sprout', options => { userData => 'fig/admin', dataDir => '/usr/fig/SproutData' });
   
 In order to work properly with [[ERDBGeneratorPl]], the constructor has an alternate  
 form.  
94    
95      my $sprout = Sprout->new(dbd => $filename);  The odd constructor signature is a result of Sprout's status as the first ERDB database,
96    and the need to make it compatible with the needs of its younger siblings.
 Where I<$fileName> is the name of the DBD file. This enables us to specify an alternate  
 DBD for the loader, which is important when the database format changes.  
97    
98  =cut  =cut
99    
100  sub new {  sub new {
101      # Get the parameters.      # Get the parameters.
102      my ($class, $dbName, $options) = @_;      my ($class, %parms) = @_;
103      # Check for the alternate signature, and default the database name if it is missing.      # Look for an options hash.
104      if ($dbName eq 'dbd') {      my $options = $parms{options} || {};
105          $dbName = $FIG_Config::sproutDB;      # Plug in the DBD and name parameters.
106          $options = { xmlFileName => $options };      if ($parms{DBD}) {
107      } elsif (! defined $dbName) {          $options->{xmlFileName} = $parms{DBD};
         $dbName = $FIG_Config::sproutDB;  
     } elsif (ref $dbName eq 'HASH') {  
         $options = $dbName;  
         $dbName = $FIG_Config::sproutDB;  
108      }      }
109        my $dbName = $parms{dbName} || $FIG_Config::sproutDB;
110      # Compute the DBD directory.      # Compute the DBD directory.
111      my $dbd_dir = (defined($FIG_Config::dbd_dir) ? $FIG_Config::dbd_dir :      my $dbd_dir = (defined($FIG_Config::dbd_dir) ? $FIG_Config::dbd_dir :
112                                                    $FIG_Config::fig );                                                    $FIG_Config::fig );
# Line 299  Line 294 
294                  $retVal = $superGroup;                  $retVal = $superGroup;
295              }              }
296          }          }
         # Make sure we found something.  
         if (! $retVal) {  
             Confess("No super-group found for \"$groupName\".");  
         }  
297      }      }
298      # Return the result.      # Return the result.
299      return $retVal;      return $retVal;
# Line 689  Line 680 
680      # Set up the multiple-select flag.      # Set up the multiple-select flag.
681      my $multipleTag = ($multiSelect ? " multiple" : "" );      my $multipleTag = ($multiSelect ? " multiple" : "" );
682      # Set up the style class.      # Set up the style class.
683      my $classTag = ($class ? " class=\"$class\"" : "" );      my $classTag = ($class ? " $class" : "" );
684      # Create the SELECT tag and stuff it into the output array.      # Create the SELECT tag and stuff it into the output array.
685      my @lines = ("<SELECT name=\"$menuName\" id=\"$menuID\" $onChangeTag$multipleTag$classTag size=\"$rows\">");      my @lines = qq(<SELECT name="$menuName" id="$menuID" class="genomeSelect $class" $onChangeTag$multipleTag$classTag size="$rows">);
686      # Loop through the groups.      # Loop through the groups.
687      for my $group (@groups) {      for my $group (@groups) {
688          # Get the genomes in the group.          # Get the genomes in the group.
# Line 724  Line 715 
715          # displayed. For multiple-select mode, we include a button that selects the displayed          # displayed. For multiple-select mode, we include a button that selects the displayed
716          # genes. For single-select mode, we use a plain label instead.          # genes. For single-select mode, we use a plain label instead.
717          my $searchThingName = "${menuID}_SearchThing";          my $searchThingName = "${menuID}_SearchThing";
718          my $searchThingLabel = ($multiSelect ? "<INPUT type=\"button\" name=\"MacroSearch\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectShowing('$menuID', '$searchThingName'); $showSelect;\" />"          my $searchThingLabel = "Type to narrow selection";
719                                               : "Show genomes containing");          my $searchThingButton = "";
720            if ($multiSelect) {
721                $searchThingButton = qq(<INPUT type="button" name="MacroSearch" class="button" value="Go" onClick="selectShowing('$menuID', '$searchThingName'); $showSelect;" />);
722            }
723          push @lines, "<br />$searchThingLabel&nbsp;" .          push @lines, "<br />$searchThingLabel&nbsp;" .
724                       "<INPUT type=\"text\" id=\"$searchThingName\" name=\"$searchThingName\" size=\"30\" onKeyup=\"showTyped('$menuID', '$searchThingName');\" />" .                       qq(<INPUT type="text" id="$searchThingName" name="$searchThingName" class="genomeSearchThing" onKeyup="showTyped('$menuID', '$searchThingName');" />) .
725                       Hint("GenomeControl", "Type here to filter the genomes displayed.") . "<br />";                       $searchThingButton .
726                         Hint("GenomeControl", 28) . "<br />";
727          # 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.
728          if ($multiSelect) {          if ($multiSelect) {
729              push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  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" />);
730              push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll(getElementById('$menuID')); $showSelect\" />";              push @lines, qq(<INPUT type="button" name="SelectAll" class="bigButton genomeButton" value="Select All" onClick="selectAll(getElementById('$menuID')); $showSelect" />);
731              push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome(getElementById('$menuID'), $nmpdrCount, true); $showSelect;\" />";              push @lines, qq(<INPUT type="button" name="NMPDROnly" class="bigButton genomeButton" value="Select NMPDR" onClick="selectSome(getElementById('$menuID'), $nmpdrCount, true); $showSelect;" />);
732          }          }
733          # Add a hidden field we can use to generate organism page hyperlinks.          # Add a hidden field we can use to generate organism page hyperlinks.
734          push @lines, "<INPUT type=\"hidden\" id=\"$urlID\" value=\"$FIG_Config::cgi_url/wiki/rest.cgi/NmpdrPlugin/SeedViewer?page=Organism;organism=\" />";          push @lines, qq(<INPUT type="hidden" id="$urlID" value="$FIG_Config::cgi_url/wiki/rest.cgi/NmpdrPlugin/SeedViewer?page=Organism;organism=" />);
735          # Add the status display. This tells the user what's selected no matter where the list is scrolled.          # Add the status display. This tells the user what's selected no matter where the list is scrolled.
736          push @lines, "<DIV id=\"$divID\" class=\"Panel\"></DIV>";          push @lines, qq(<DIV id="$divID" class="Panel"></DIV>);
737      }      }
738      # Assemble all the lines into a string.      # Assemble all the lines into a string.
739      my $retVal = join("\n", @lines, "");      my $retVal = join("\n", @lines, "");
# Line 746  Line 741 
741      return $retVal;      return $retVal;
742  }  }
743    
744    =head3 Cleanup
745    
746        $sprout->Cleanup();
747    
748    Release the internal cache structures to free up memory.
749    
750    =cut
751    
752    sub Cleanup {
753        # Get the parameters.
754        my ($self) = @_;
755        # Delete the stemmer.
756        delete $self->{stemmer};
757        # Delete the attribute database.
758        delete $self->{_ca};
759        # Delete the group hash.
760        delete $self->{groupHash};
761        # Is there a FIG object?
762        if (defined $self->{fig}) {
763            # Yes, clear its subsystem cache.
764            $self->{fig}->clear_subsystem_cache();
765        }
766    }
767    
768    
769  =head3 Stem  =head3 Stem
770    
# Line 1000  Line 1019 
1019  }  }
1020    
1021    
   
1022  =head3 PointLocation  =head3 PointLocation
1023    
1024      my $found = Sprout::PointLocation($location, $point);      my $found = Sprout::PointLocation($location, $point);
# Line 3979  Line 3997 
3997    
3998  =over 4  =over 4
3999    
4000  =item page  =item specials
4001    
4002  The super-group's web page in the NMPDR.  Reference to a hash whose keys are the names of special species.
4003    
4004  =item contents  =item contents
4005    
# Line 4004  Line 4022 
4022          my @groupLines = Tracer::GetFile("$FIG_Config::sproutData/groups.tbl");          my @groupLines = Tracer::GetFile("$FIG_Config::sproutData/groups.tbl");
4023          # Loop through the list of sort-of groups.          # Loop through the list of sort-of groups.
4024          for my $groupLine (@groupLines) {          for my $groupLine (@groupLines) {
4025              my ($name, $page, @contents) = split /\t/, $groupLine;              my ($name, $specials, @contents) = split /\t/, $groupLine;
4026              $groupHash{$name} = { page => $page,              $groupHash{$name} = { specials => { map { $_ => 1 } split /\s*,\s*/, $specials },
4027                                    contents => [ map { [ split /\s*,\s*/, $_ ] } @contents ]                                    contents => [ map { [ split /\s*,\s*/, $_ ] } @contents ]
4028                                  };                                  };
4029          }          }
# Line 4066  Line 4084 
4084  sub GetSourceObject {  sub GetSourceObject {
4085      # Get the parameters.      # Get the parameters.
4086      my ($self) = @_;      my ($self) = @_;
4087      # Check to see if we already have a source object.      # Do we already have one?
4088      my $retVal = $self->{_fig};      my $retVal = $self->{fig};
4089      if (! defined $retVal) {      if (! defined $retVal) {
4090          # No, so create one.          # Create the object.
4091          require FIG;          require FIG;
4092          $retVal = FIG->new();          $retVal = FIG->new();
4093            Trace("FIG source object created for process $$.") if T(ERDBLoadGroup => 3);
4094            # Set up retries to prevent the lost-connection error when harvesting
4095            # the feature data.
4096            my $dbh = $retVal->db_handle();
4097            $dbh->set_retries(5);
4098            # Save it for other times.
4099            $self->{fig} = $retVal;
4100      }      }
4101      # Return the object.      # Return the object.
4102      return $retVal;      return $retVal;
# Line 4079  Line 4104 
4104    
4105  =head3 SectionList  =head3 SectionList
4106    
4107      my @sections = $erdb->SectionList();      my @sections = $erdb->SectionList($fig);
4108    
4109  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.
4110  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 4092  Line 4117 
4117      my ($self, $source) = @_;      my ($self, $source) = @_;
4118      # Ask the BaseSproutLoader for a section list.      # Ask the BaseSproutLoader for a section list.
4119      require BaseSproutLoader;      require BaseSproutLoader;
4120      my @retVal = BaseSproutLoader::GetSectionList($self);      my @retVal = BaseSproutLoader::GetSectionList($self, $source);
4121      # Return the list.      # Return the list.
4122      return @retVal;      return @retVal;
4123  }  }
# Line 4102  Line 4127 
4127      my $groupLoader = $erdb->Loader($groupName, $options);      my $groupLoader = $erdb->Loader($groupName, $options);
4128    
4129  Return an [[ERDBLoadGroupPm]] object for the specified load group. This method is used  Return an [[ERDBLoadGroupPm]] object for the specified load group. This method is used
4130  by [[ERDBGeneratorPl]] to create the load group objects. If you are not using  by L<ERDBGenerator.pl> to create the load group objects. If you are not using
4131  [[ERDBGeneratorPl]], you don't need to override this method.  L<ERDBGenerator.pl>, you don't need to override this method.
4132    
4133  =over 4  =over 4
4134    
# Line 4146  Line 4171 
4171      my @groups = $erdb->LoadGroupList();      my @groups = $erdb->LoadGroupList();
4172    
4173  Returns a list of the names for this database's load groups. This method is used  Returns a list of the names for this database's load groups. This method is used
4174  by [[ERDBGeneratorPl]] when the user wishes to load all table groups. The default  by L<ERDBGenerator.pl> when the user wishes to load all table groups. The default
4175  is a single group called 'All' that loads everything.  is a single group called 'All' that loads everything.
4176    
4177  =cut  =cut
4178    
4179  sub LoadGroupList {  sub LoadGroupList {
4180      # Return the list.      # Return the list.
4181      return qw(Genome Subsystem Annotation Property Source Reaction Synonym Feature Drug);      return qw(Feature Subsystem Genome Annotation Property Source Reaction Synonym Drug);
4182  }  }
4183    
4184  =head3 LoadDirectory  =head3 LoadDirectory
# Line 4320  Line 4345 
4345    
4346  =head3 Hint  =head3 Hint
4347    
4348      my $htmlText = SearchHelper::Hint($wikiPage, $hintText);      my $htmlText = Sprout::Hint($wikiPage, $hintID);
4349    
4350  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.
4351  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.
4352    
4353  =over 4  =over 4
# Line 4331  Line 4356 
4356    
4357  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.
4358    
4359  =item hintText  =item hintID
4360    
4361  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
4362    in the Wiki.
4363    
4364  =item RETURN  =item RETURN
4365    
4366  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
4367  uses the standard FIG popup technology.  uses the standard FIG popup technology.
4368    
4369  =back  =back
# Line 4346  Line 4372 
4372    
4373  sub Hint {  sub Hint {
4374      # Get the parameters.      # Get the parameters.
4375      my ($wikiPage, $hintText) = @_;      my ($wikiPage, $hintID) = @_;
4376      # Escape the single quotes in the hint text.      # Declare the return variable.
4377      my $quotedText = $hintText;      my $retVal;
     $quotedText =~ s/'/\\'/g;  
4378      # Convert the wiki page name to a URL.      # Convert the wiki page name to a URL.
4379      my $wikiURL = join("", map { ucfirst $_ } split /\s+/, $wikiPage);      my $wikiURL;
4380      $wikiURL = "$FIG_Config::cgi_url/wiki/view.cgi/FIG/$wikiURL";      if ($wikiPage =~ m#/#) {
4381      # Compute the mouseover script.          # Here it's a URL of some sort.
4382      my $mouseOver = "doTooltip(this, '$quotedText')";          $wikiURL = $wikiPage;
4383      # Create the html.      } else {
4384      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.
4385      # Return it.          my $page = join("", map { ucfirst $_ } split /\s+/, $wikiPage);
4386            if ($page =~ /^(.+?)\.(.+)$/) {
4387                $page = "$1/$2";
4388            } else {
4389                $page = "FIG/$page";
4390            }
4391            $wikiURL = "$FIG_Config::cgi_url/wiki/view.cgi/$page";
4392        }
4393        # Is there hint text?
4394        if (! $hintID) {
4395            # No. Create a new-page hint.
4396            $retVal = qq(&nbsp;<a class="hint" onclick="doPagePopup(this, '$wikiURL')">(help)</a>);
4397        } else {
4398            # With hint text, we create a popup window hint. We need to compute the hint URL.
4399            my $tipURL = "$FIG_Config::cgi_url/wiki/view.cgi/FIG/TWikiCustomTip" .
4400                Tracer::Pad($hintID, 3, 1, "0");
4401            # Create a hint pop-up link.
4402            $retVal = qq(&nbsp;<a class="hint" onclick="doHintPopup(this, '$wikiURL', '$tipURL')">(help)</a>);
4403        }
4404        # Return the HTML.
4405      return $retVal;      return $retVal;
4406  }  }
4407    

Legend:
Removed from v.1.123  
changed lines
  Added in v.1.128

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3