[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.102, Thu Dec 6 14:56:23 2007 UTC revision 1.110, Tue Apr 29 20:54:51 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 78  Line 79 
79    
80  * B<noDBOpen> suppresses the connection to the database if TRUE, else FALSE  * B<noDBOpen> suppresses the connection to the database if TRUE, else FALSE
81    
82    * B<host> name of the database host
83    
84  =back  =back
85    
86  For example, the following constructor call specifies a database named I<Sprout> and a user name of  For example, the following constructor call specifies a database named I<Sprout> and a user name of
87  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
88  F</usr/fig/SproutData>.  F</usr/fig/SproutData>.
89    
90      my $sprout = Sprout->new('Sprout', { userData =>; 'fig/admin', dataDir => '/usr/fig/SproutData' });      my $sprout = Sprout->new('Sprout', { userData => 'fig/admin', dataDir => '/usr/fig/SproutData' });
91    
92  =cut  =cut
93    
# Line 108  Line 111 
111                         port         => $FIG_Config::dbport,                         port         => $FIG_Config::dbport,
112                                                          # database connection port                                                          # database connection port
113                         sock         => $FIG_Config::dbsock,                         sock         => $FIG_Config::dbsock,
114                         host         => $FIG_Config::dbhost,                         host         => $FIG_Config::sprout_host,
115                         maxSegmentLength => 4500,        # maximum feature segment length                         maxSegmentLength => 4500,        # maximum feature segment length
116                         maxSequenceLength => 8000,       # maximum contig sequence length                         maxSequenceLength => 8000,       # maximum contig sequence length
117                         noDBOpen     => 0,               # 1 to suppress the database open                         noDBOpen     => 0,               # 1 to suppress the database open
# Line 121  Line 124 
124      # Connect to the database.      # Connect to the database.
125      my $dbh;      my $dbh;
126      if (! $optionTable->{noDBOpen}) {      if (! $optionTable->{noDBOpen}) {
127            Trace("Connect data: host = $optionTable->{host}, port = $optionTable->{port}.") if T(3);
128          $dbh = DBKernel->new($optionTable->{dbType}, $dbName, $userName,          $dbh = DBKernel->new($optionTable->{dbType}, $dbName, $userName,
129                                  $password, $optionTable->{port}, $optionTable->{host}, $optionTable->{sock});                                  $password, $optionTable->{port}, $optionTable->{host}, $optionTable->{sock});
130      }      }
# Line 147  Line 151 
151      return $retVal;      return $retVal;
152  }  }
153    
154    =head3 CoreGenomes
155    
156        my @genomes = $sprout->CoreGenomes($scope);
157    
158    Return the IDs of NMPDR genomes in the specified scope.
159    
160    =over 4
161    
162    =item scope
163    
164    Scope of the desired genomes. C<core> covers the original core genomes,
165    C<nmpdr> covers all genomes in NMPDR groups, and C<all> covers all
166    genomes in the system.
167    
168    =item RETURN
169    
170    Returns a list of the IDs for the genomes in the specified scope.
171    
172    =back
173    
174    =cut
175    
176    sub CoreGenomes {
177        # Get the parameters.
178        my ($self, $scope) = @_;
179        # Declare the return variable.
180        my @retVal = ();
181        # If we want all genomes, then this is easy.
182        if ($scope eq 'all') {
183            @retVal = $self->Genomes();
184        } else {
185            # Here we're dealing with groups. Get the hash of all the
186            # genome groups.
187            my %groups = $self->GetGroups();
188            # Loop through the groups, keeping the ones that we want.
189            for my $group (keys %groups) {
190                # Decide if we want to keep this group.
191                my $keepGroup = 0;
192                if ($scope eq 'nmpdr') {
193                    # NMPDR mode: keep all groups.
194                    $keepGroup = 1;
195                } elsif ($scope eq 'core') {
196                    # CORE mode. Only keep real core groups.
197                    if (grep { $group =~ /$_/ } @{$FIG_Config::realCoreGroups}) {
198                        $keepGroup = 1;
199                    }
200                }
201                # Add this group if we're keeping it.
202                if ($keepGroup) {
203                    push @retVal, @{$groups{$group}};
204                }
205            }
206        }
207        # Return the result.
208        return @retVal;
209    }
210    
211    =head3 SuperGroup
212    
213        my $superGroup = $sprout->SuperGroup($groupName);
214    
215    Return the name of the super-group containing the specified NMPDR genome
216    group. If no appropriate super-group can be found, an error will be
217    thrown.
218    
219    =over 4
220    
221    =item groupName
222    
223    Name of the group whose super-group is desired.
224    
225    =item RETURN
226    
227    Returns the name of the super-group containing the incoming group.
228    
229    =back
230    
231    =cut
232    
233    sub SuperGroup {
234        # Get the parameters.
235        my ($self, $groupName) = @_;
236        # Declare the return variable.
237        my $retVal;
238        # Get the group hash.
239        my %groupHash = $self->CheckGroupFile();
240        # Find the super-group genus.
241        $groupName =~ /([A-Z]\w+)/;
242        my $nameThing = $1;
243        # See if it's directly in the group hash.
244        if (exists $groupHash{$nameThing}) {
245            # Yes, then it's our result.
246            $retVal = $nameThing;
247        } else {
248            # No, so we have to search.
249            for my $superGroup (keys %groupHash) {
250                # Get this super-group's item list.
251                my $list = $groupHash{$superGroup}->{contents};
252                # Search it.
253                if (grep { $_->[0] eq $nameThing } @{$list}) {
254                    $retVal = $superGroup;
255                }
256            }
257            # Make sure we found something.
258            if (! $retVal) {
259                Confess("No super-group found for \"$groupName\".");
260            }
261        }
262        # Return the result.
263        return $retVal;
264    }
265    
266  =head3 MaxSegment  =head3 MaxSegment
267    
268      my $length = $sprout->MaxSegment();      my $length = $sprout->MaxSegment();
# Line 267  Line 383 
383              Trace("No load file found for $tableName in $dataDir.") if T(0);              Trace("No load file found for $tableName in $dataDir.") if T(0);
384          } else {          } else {
385              # Attempt to load this table.              # Attempt to load this table.
386              my $result = $self->LoadTable($fileName, $tableName, $truncateFlag);              my $result = $self->LoadTable($fileName, $tableName, truncate => $truncateFlag);
387              # Accumulate the resulting statistics.              # Accumulate the resulting statistics.
388              $retVal->Accumulate($result);              $retVal->Accumulate($result);
389          }          }
# Line 350  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  Reference to a hash mapping attributes to values for the SELECT tag generated.  Optional parameters for the control (see below).
482    
483  =item filterString  =item RETURN
484    
485  A filter string for use in selecting the genomes. The filter string must conform  Returns the HTML for a genome selection control on a form (sometimes called a popup menu).
 to the rules for the C<< ERDB->Get >> method.  
486    
487  =item params  =back
488    
489  Reference to a list of values to be substituted in for the parameter marks in  The valid options are as follows.
 the filter string.  
490    
491  =item selected (optional)  =over 4
492    
493  ID of the genome to be initially selected.  =item name
494    
495  =item fast (optional)  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  If specified and TRUE, the contig counts will be omitted to improve performance.  =item filter
499    
500  =item RETURN  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 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  Returns an HTML select menu with the specified genomes as selectable options.  =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    A comma-delimited list of selected genomes, or a reference to a list of selected genomes. The
520    default is none.
521    
522    =item class
523    
524    If specified, a style class to assign to the genome control.
525    
526  =back  =back
527    
528  =cut  =cut
529    
530  sub GeneMenu {  sub GenomeMenu {
531      # Get the parameters.      # Get the parameters.
532      my ($self, $attributes, $filterString, $params, $selected, $fast) = @_;      my ($self, %options) = @_;
533      my $slowMode = ! $fast;      # Get the control's name and ID.
534      # Default to nothing selected. This prevents an execution warning if "$selected"      my $menuName = $options{name} || 'myGenomeControl';
535      # is undefined.      my $menuID = $options{id} || $menuName;
536      $selected = "" unless defined $selected;      # Compute the IDs for the status display.
537      Trace("Gene Menu called with slow mode \"$slowMode\" and selection \"$selected\".") if T(3);      my $divID = "${menuID}_status";
538      # Start the menu.      my $urlID = "${menuID}_url";
539      my $retVal = "<select " .      # Compute the code to show selected genomes in the status area.
540          join(" ", map { "$_=\"$attributes->{$_}\"" } keys %{$attributes}) .      my $showSelect = "showSelected('$menuID', '$divID', '$urlID', 1000)";
541          ">\n";      # Check for single-select or multi-select.
542      # Get the genomes.      my $multiSelect = $options{multiSelect} || 0;
543      my @genomes = $self->GetAll(['Genome'], $filterString, $params, ['Genome(id)',      # Get the style data.
544                                                                       'Genome(genus)',      my $class = $options{class} || '';
545                                                                       'Genome(species)',      # Get the list of pre-selected items.
546                                                                       'Genome(unique-characterization)']);      my $selections = $options{selected} || [];
547      # Sort them by name.      if (ref $selections ne 'ARRAY') {
548      my @sorted = sort { lc("$a->[1] $a->[2]") cmp lc("$b->[1] $b->[2]") } @genomes;          $selections = [ split /\s*,\s*/, $selections ];
549      # Loop through the genomes, creating the option tags.      }
550      for my $genomeData (@sorted) {      my %selected = map { $_ => } @{$selections};
551          # Get the data for this genome.      # Extract the filter information. The default is no filtering. It can be passed as a tab-delimited
552          my ($genomeID, $genus, $species, $strain) = @{$genomeData};      # string or a list reference.
553          # Get the contig count.      my $filterParms = $options{filter} || "";
554          my $contigInfo = "";      if (! ref $filterParms) {
555          if ($slowMode) {          $filterParms = [split /\t|\\t/, $filterParms];
556              my $count = $self->ContigCount($genomeID);      }
557              my $counting = ($count == 1 ? "contig" : "contigs");      my $filterString = shift @{$filterParms};
558              $contigInfo = "[$count $counting]";      # Get a list of all the genomes in group order. In fact, we only need them ordered
559          }      # by name (genus,species,strain), but putting primary-group in front enables us to
560          # Find out if we're selected.      # take advantage of an existing index.
561          my $selectOption = ($selected eq $genomeID ? " selected" : "");      my @genomeList = $self->GetAll(['Genome'], "$filterString ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",
562          # Build the option tag.                                     $filterParms,
563          $retVal .= "<option value=\"$genomeID\"$selectOption>$genus $species $strain ($genomeID)$contigInfo</option>\n";                                     [qw(Genome(primary-group) Genome(id) Genome(genus) Genome(species) Genome(unique-characterization) Genome(taxonomy) Genome(contigs))]);
564        # Create a hash to organize the genomes by group. Each group will contain a list of
565        # 2-tuples, the first element being the genome ID and the second being the genome
566        # name.
567        my %gHash = ();
568        for my $genome (@genomeList) {
569            # Get the genome data.
570            my ($group, $genomeID, $genus, $species, $strain, $taxonomy, $contigs) = @{$genome};
571            # Compute its name. This is the genus, species, strain (if any), and the contig count.
572            my $name = "$genus $species ";
573            $name .= "$strain " if $strain;
574            my $contigCount = ($contigs == 1 ? "" : ", $contigs contigs");
575            # Now we get the domain. The domain tells us the display style of the organism.
576            my ($domain) = split /\s*;\s*/, $taxonomy, 2;
577            # Now compute the display group. This is normally the primary group, but if the
578            # organism is supporting, we blank it out.
579            my $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
580            # Push the genome into the group's list. Note that we use the real group
581            # name for the hash key here, not the display group name.
582            push @{$gHash{$group}}, [$genomeID, $name, $contigCount, $domain];
583        }
584        # We are almost ready to unroll the menu out of the group hash. The final step is to separate
585        # the supporting genomes by domain. First, we extract the NMPDR groups and sort them. They
586        # are sorted by the first capitalized word. Groups with "other" are sorted after groups
587        # that aren't "other". At some point, we will want to make this less complicated.
588        my %sortGroups = map { $_ =~ /(other)?(.*)([A-Z].+)/; "$3$1$2" => $_ }
589                             grep { $_ ne $FIG_Config::otherGroup } keys %gHash;
590        my @groups = map { $sortGroups{$_} } sort keys %sortGroups;
591        # Remember the number of NMPDR groups.
592        my $nmpdrGroupCount = scalar @groups;
593        # Loop through the supporting genomes, classifying them by domain. We'll also keep a list
594        # of the domains found.
595        my @otherGenomes = @{$gHash{$FIG_Config::otherGroup}};
596        my @domains = ();
597        for my $genomeData (@otherGenomes) {
598            my ($genomeID, $name, $contigCount, $domain) = @{$genomeData};
599            if (exists $gHash{$domain}) {
600                push @{$gHash{$domain}}, $genomeData;
601            } else {
602                $gHash{$domain} = [$genomeData];
603                push @domains, $domain;
604            }
605        }
606        # Add the domain groups at the end of the main group list. The main group list will now
607        # contain all the categories we need to display the genomes.
608        push @groups, sort @domains;
609        # Delete the supporting group.
610        delete $gHash{$FIG_Config::otherGroup};
611        # Now it gets complicated. We need a way to mark all the NMPDR genomes. We take advantage
612        # of the fact they come first in the list. We'll accumulate a count of the NMPDR genomes
613        # and use that to make the selections.
614        my $nmpdrCount = 0;
615        # Create the type counters.
616        my $groupCount = 1;
617        # Get the number of rows to display.
618        my $rows = $options{size} || 10;
619        # If we're multi-row, create an onChange event.
620        my $onChangeTag = ( $rows > 1 ? " onChange=\"$showSelect;\" onFocus=\"$showSelect;\"" : "" );
621        # Set up the multiple-select flag.
622        my $multipleTag = ($multiSelect ? " multiple" : "" );
623        # Set up the style class.
624        my $classTag = ($class ? " class=\"$class\"" : "" );
625        # Create the SELECT tag and stuff it into the output array.
626        my @lines = ("<SELECT name=\"$menuID\" id=\"$menuID\" $onChangeTag$multipleTag$classTag size=\"$rows\">");
627        # Loop through the groups.
628        for my $group (@groups) {
629            # Get the genomes in the group.
630            for my $genome (@{$gHash{$group}}) {
631                # If this is an NMPDR organism, we add an extra style and count it.
632                my $nmpdrStyle = "";
633                if ($nmpdrGroupCount > 0) {
634                    $nmpdrCount++;
635                    $nmpdrStyle = " Core";
636                }
637                # Get the organism ID, name, contig count, and domain.
638                my ($genomeID, $name, $contigCount, $domain) = @{$genome};
639                # See if we're pre-selected.
640                my $selectTag = ($selected{$genomeID} ? " SELECTED" : "");
641                # Compute the display name.
642                my $nameString = "$name ($genomeID$contigCount)";
643                # Generate the option tag.
644                my $optionTag = "<OPTION class=\"$domain$nmpdrStyle\" title=\"$group\" value=\"$genomeID\"$selectTag>$nameString</OPTION>";
645                push @lines, "    $optionTag";
646            }
647            # Record this group in the nmpdrGroup count. When that gets to 0, we've finished the NMPDR
648            # groups.
649            $nmpdrGroupCount--;
650      }      }
651      # Close the SELECT tag.      # Close the SELECT tag.
652      $retVal .= "</select>\n";      push @lines, "</SELECT>";
653        if ($rows > 1) {
654            # We're in a non-compact mode, so we need to add some selection helpers. First is
655            # the search box. This allows the user to type text and change which genomes are
656            # displayed. For multiple-select mode, we include a button that selects the displayed
657            # genes. For single-select mode, we use a plain label instead.
658            my $searchThingName = "${menuID}_SearchThing";
659            my $searchThingLabel = ($multiSelect ? "<INPUT type=\"button\" name=\"MacroSearch\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectShowing('$menuID', '$searchThingName'); $showSelect;\" />"
660                                                 : "Show genomes containing");
661            push @lines, "<br />$searchThingLabel&nbsp;" .
662                         "<INPUT type=\"text\" id=\"$searchThingName\" name=\"$searchThingName\" size=\"30\" onKeyup=\"showTyped('$menuID', '$searchThingName');\" />";
663            # For multi-select mode, we also have buttons to set and clear selections.
664            if ($multiSelect) {
665                push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll('$menuID'); $showSelect\" />";
666                push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll('$menuID'); $showSelect\" />";
667                push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome('$menuID', $nmpdrCount, true); $showSelect;\" />";
668            }
669            # Add a hidden field we can use to generate organism page hyperlinks.
670            push @lines, "<INPUT type=\"hidden\" id=\"$urlID\" value=\"$FIG_Config::cgi_url/seedviewer.cgi?page=Organism;organism=\" />";
671            # Add the status display. This tells the user what's selected no matter where the list is scrolled.
672            push @lines, "<DIV id=\"$divID\" class=\"Panel\"></DIV>";
673        }
674        # Assemble all the lines into a string.
675        my $retVal = join("\n", @lines, "");
676      # Return the result.      # Return the result.
677      return $retVal;      return $retVal;
678  }  }
679    
680    
681  =head3 Build  =head3 Build
682    
683      $sprout->Build();      $sprout->Build();
# Line 568  Line 815 
815  =item RETURN  =item RETURN
816    
817  Returns a list of the feature's contig segments. The locations are returned as a list in a list  Returns a list of the feature's contig segments. The locations are returned as a list in a list
818  context and as a comma-delimited string in a scalar context.  context and as a comma-delimited string in a scalar context. An empty list means the feature
819    wasn't found.
820    
821  =back  =back
822    
# Line 577  Line 825 
825  sub FeatureLocation {  sub FeatureLocation {
826      # Get the parameters.      # Get the parameters.
827      my ($self, $featureID) = @_;      my ($self, $featureID) = @_;
828        # Declare the return variable.
829        my @retVal = ();
830      # Get the feature record.      # Get the feature record.
831      my $object = $self->GetEntity('Feature', $featureID);      my $object = $self->GetEntity('Feature', $featureID);
832      Confess("Feature $featureID not found.") if ! defined($object);      # Only proceed if we found it.
833        if (defined $object) {
834      # Get the location string.      # Get the location string.
835      my $locString = $object->PrimaryValue('Feature(location-string)');      my $locString = $object->PrimaryValue('Feature(location-string)');
836      # Create the return list.      # Create the return list.
837      my @retVal = split /\s*,\s*/, $locString;          @retVal = split /\s*,\s*/, $locString;
838        }
839      # Return the list in the format indicated by the context.      # Return the list in the format indicated by the context.
840      return (wantarray ? @retVal : join(',', @retVal));      return (wantarray ? @retVal : join(',', @retVal));
841  }  }
# Line 3039  Line 3291 
3291          my ($taxonomy) = $self->GetFlat(['IsLocatedIn', 'HasContig', 'Genome'], "IsLocatedIn(from-link) = ?",          my ($taxonomy) = $self->GetFlat(['IsLocatedIn', 'HasContig', 'Genome'], "IsLocatedIn(from-link) = ?",
3292                                          [$fid], 'Genome(taxonomy)');                                          [$fid], 'Genome(taxonomy)');
3293          # Add this feature to the hash buffer.          # Add this feature to the hash buffer.
3294          Tracer::AddToListMap(\%hashBuffer, $taxonomy, $fid);          push @{$hashBuffer{$taxonomy}}, $fid;
3295      }      }
3296      # Sort the keys and get the elements.      # Sort the keys and get the elements.
3297      my @retVal = ();      my @retVal = ();
# Line 3618  Line 3870 
3870      my ($self, %groupHash) = @_;      my ($self, %groupHash) = @_;
3871      # Create the result hash.      # Create the result hash.
3872      my %retVal = ();      my %retVal = ();
     # Get the super-group table.  
     my %superTable = $self->CheckGroupFile();  
3873      # Copy over the genomes.      # Copy over the genomes.
3874      for my $groupID (keys %groupHash) {      for my $groupID (keys %groupHash) {
3875          # Get the super-group name.          # Get the super-group name.
3876          my $realGroupID;          my $realGroupID = $self->SuperGroup($groupID);
3877          if ($groupID =~ /([A-Z]\w+)/) {          # Append this group's genomes into the result hash
3878              my $sortOfGroup = $1;          # using the super-group name.
             if (! defined($superTable{$1})) {  
                 Confess("Super-group name not found for group $groupID.");  
             } else {  
                 $realGroupID = $superTable{$1}->{superGroup};  
             }  
         } else {  
             Confess("Invalid group name $groupID.");  
         }  
         # Append this group's genomes into the result hash.  
3879          push @{$retVal{$realGroupID}}, @{$groupHash{$groupID}};          push @{$retVal{$realGroupID}}, @{$groupHash{$groupID}};
3880      }      }
3881      # Return the result hash.      # Return the result hash.
# Line 3665  Line 3906 
3906  sub GroupPageName {  sub GroupPageName {
3907      # Get the parameters.      # Get the parameters.
3908      my ($self, $group) = @_;      my ($self, $group) = @_;
     # Declare the return variable.  
     my $retVal;  
3909      # Check for the group file data.      # Check for the group file data.
3910      my %superTable = $self->CheckGroupFile();      my %superTable = $self->CheckGroupFile();
3911      # Compute the real group name.      # Compute the real group name.
3912      my ($realGroup, $pageLink);      my $realGroup = $self->SuperGroup($group);
3913      if ($group =~ /([A-Z]\w+)/) {      # Get the associated page name.
3914          my $sortOfGroup = $1;      my $retVal = "../content/$superTable{$realGroup}->{page}";
         if (! defined($superTable{$1})) {  
             Confess("No sort-of group found for \"$group\".");  
         } else {  
             $pageLink = $superTable{$1}->{page};  
         }  
     } else {  
         Confess("\"group\" is not a valid group name.");  
     }  
     # Return the page name.  
     $retVal = "../content/" . $pageLink;  
3915      # Return the result.      # Return the result.
3916      return $retVal;      return $retVal;
3917  }  }
# Line 3725  Line 3954 
3954    
3955  Get the group file hash. The group file hash describes the relationship  Get the group file hash. The group file hash describes the relationship
3956  between a group and the super-group to which it belongs for purposes of  between a group and the super-group to which it belongs for purposes of
3957  display. The super-group name is computed from the sort-of group name,  display. The super-group name is computed from the first capitalized word
3958  which is the first capitalized word in the actual group name. For each  in the actual group name. For each super-group, the group file contains
3959  sort-of group, the group file contains the super-group name, the group  the page name and a list of the species expected to be in the group.
3960  genus, the list of applicable species (if any), and the name of the NMPDR  Each species is specified by a genus and a species name. A species name
3961  display page for the super-group.  of C<0> implies an entire genus.
3962    
3963  This method returns a hash from sort-of group names to hash reference. Each  This method returns a hash from super-group names to a hash reference. Each
3964  resulting hash reference contains the following fields.  resulting hash reference contains the following fields.
3965    
3966  =over 4  =over 4
3967    
 =item superGroup  
   
 Super-group name.  
   
3968  =item page  =item page
3969    
3970  The super-group's web page in the NMPDR.  The super-group's web page in the NMPDR.
3971    
3972  =item genus  =item contents
   
 The genus of the sort-of group.  
3973    
3974  =item species  A list of 2-tuples, each containing a genus name followed by a species name
3975    (or 0, indicating all species). This list indicates which organisms belong
3976  A reference to a list of the species for the sort-of group.  in the super-group.
3977    
3978  =back  =back
3979    
# Line 3767  Line 3990 
3990          my @groupLines = Tracer::GetFile("$FIG_Config::sproutData/groups.tbl");          my @groupLines = Tracer::GetFile("$FIG_Config::sproutData/groups.tbl");
3991          # Loop through the list of sort-of groups.          # Loop through the list of sort-of groups.
3992          for my $groupLine (@groupLines) {          for my $groupLine (@groupLines) {
3993              my ($mainName, $name, $page, $genus, $species) = split(/\t/, $groupLine);              my ($name, $page, @contents) = split /\t/, $groupLine;
3994              $groupHash{$name} = { page => $page,              $groupHash{$name} = { page => $page,
3995                                 genus => $genus,                                    contents => [ map { [ split /\s*,\s*/, $_ ] } @contents ]
3996                                 species => [ split(/\s*,\s*/, $species) ],                                  };
                                superGroup => $mainName };  
3997          }          }
3998          # Save the hash.          # Save the hash.
3999          $self->{groupHash} = \%groupHash;          $self->{groupHash} = \%groupHash;

Legend:
Removed from v.1.102  
changed lines
  Added in v.1.110

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3