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

Diff of /Sprout/SproutSubsys.pm

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

revision 1.2, Tue Oct 18 20:06:22 2005 UTC revision 1.18, Tue Sep 9 21:02:10 2008 UTC
# Line 56  Line 56 
56    
57  List of [roleID, abbreviation] tuples in column order.  List of [roleID, abbreviation] tuples in column order.
58    
59    =item dir
60    
61    Directory root for the diagram and image files.
62    
63  =item reactionHash  =item reactionHash
64    
65  Map of role IDs to a list of the reactions catalyzed by the role.  Map of role IDs to a list of the reactions catalyzed by the role.
# Line 65  Line 69 
69  Map of PEG IDs to cluster numbers. This is used to create color maps for  Map of PEG IDs to cluster numbers. This is used to create color maps for
70  display of a subsystem's PEGs.  display of a subsystem's PEGs.
71    
72    =item hopeReactions
73    
74    Map of roles to EC numbers for the Hope reactions. This object is not loaded
75    until it is needed.
76    
77  =back  =back
78    
79  =cut  =cut
# Line 75  Line 84 
84    
85  =head3 new  =head3 new
86    
87  C<< my $sub = Subsystem->new($subName, $sprout); >>      my $sub = SproutSubsys->new($subName, $sprout);
88    
89  Load the subsystem.  Load the subsystem.
90    
# Line 102  Line 111 
111      }      }
112      # Declare the return value.      # Declare the return value.
113      my $retVal;      my $retVal;
114      # Get the subsystem's data fields.      # Get the subsystem's object.
115      my ($curator, $notes) = $sprout->GetEntityValues('Subsystem', $subName, ['Subsystem(curator)',      my $subsystemObject = $sprout->GetEntity('Subsystem', $subName);
116                                                                               'Subsystem(notes)']);      if (! defined $subsystemObject) {
117      # Only proceed if we found the subsystem.          # Here we're stuck.
118      if (defined $curator) {          Confess("Subsystem \"$subName\" not found in database.");
119        } else {
120            # We've found it, so get the major data.
121            my ($curator, $notes, $description, $version) = $subsystemObject->Values(['Subsystem(curator)', 'Subsystem(notes)',
122                                                                'Subsystem(description)', 'Subsystem(version)']);
123          # Get the genome IDs and variant codes for the rows. The list returned          # Get the genome IDs and variant codes for the rows. The list returned
124          # by GetAll will be a list of 2-tuples, each consisting of a genome ID          # by GetAll will be a list of 2-tuples, each consisting of a genome ID
125          # and a subsystem variant code.          # and a subsystem variant code.
# Line 121  Line 134 
134          # Get the role IDs and abbreviations. The list returned by GetAll will be          # Get the role IDs and abbreviations. The list returned by GetAll will be
135          # a list of 2-tuples, each consisting of a role ID and abbreviation. The          # a list of 2-tuples, each consisting of a role ID and abbreviation. The
136          # 2-tuples will be ordered by the spreadsheet column number.          # 2-tuples will be ordered by the spreadsheet column number.
137          my @roles = $sprout->GetAll(['OccursInSubsystem', 'Role'],          my @roles = $sprout->GetAll(['OccursInSubsystem'],
138                                      'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',                                      'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',
139                                      [$subName], ['OccursInSubsystem(from-link)', 'Role(abbr)']);                                      [$subName], ['OccursInSubsystem(from-link)', 'OccursInSubsystem(abbr)',
140                                                     'OccursInSubsystem(auxiliary)']);
141          # Now we need to create the role ID directory and the reaction hash.          # Now we need to create the role ID directory and the reaction hash.
142          # The role ID directory maps role IDs and their abbreviations to column numbers.          # The role ID directory maps role IDs and their abbreviations to column numbers.
143          # The reaction hash maps a role ID to a list of the IDs for the reactions it          # The reaction hash maps a role ID to a list of the IDs for the reactions it
144          # catalyzes.          # catalyzes.
145          my %roleHash = ();          my %roleHash = ();
146            my %abbrHash = ();
147            my %auxHash = ();
148          my %reactionHash = ();          my %reactionHash = ();
149          for ($idx = 0; $idx <= $#roles; $idx++) {          for ($idx = 0; $idx <= $#roles; $idx++) {
150              # Get the role ID and abbreviation for this column's role.              # Get the role ID, aux flag, and abbreviation for this column's role.
151              my ($roleID, $abbr) = @{$roles[$idx]};              my ($roleID, $abbr, $aux) = @{$roles[$idx]};
152              # Put them both in the role directory.              # Put the ID and abbreviation in the role directory.
153              $roleHash{$roleID} = $idx;              $roleHash{$roleID} = $idx;
154              $roleHash{$abbr} = $idx;              $roleHash{$abbr} = $idx;
155                # Put the aux flag in the aux hash.
156                $auxHash{$roleID} = $aux;
157                # Put the full name in the abbreviation directory.
158                $abbrHash{$abbr} = $roleID;
159              # Get this role's reactions.              # Get this role's reactions.
160              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',
161                                               [$roleID], 'Catalyzes(to-link)');                                               [$roleID], 'Catalyzes(to-link)');
162              # Put them in the reaction hash.              # Put them in the reaction hash.
163                if (@reactions > 0) {
164              $reactionHash{$roleID} = \@reactions;              $reactionHash{$roleID} = \@reactions;
165          }          }
166            }
167            # Find the subsystem directory.
168            my $subDir = Subsystem::get_dir_from_name($subName);
169            Trace("Subsystem directory is $subDir.") if T(3);
170          # Create the subsystem object.          # Create the subsystem object.
171          $retVal = {          $retVal = {
172                      # Name of the subsystem. This is needed for any further database                      # Name of the subsystem. This is needed for any further database
173                      # accesses required.                      # accesses required.
174                      name => $subName,                      name => $subName,
175                        # Directory root for diagram and image files.
176                        dir => $subDir,
177                      # Name of the subsystem's official curator.                      # Name of the subsystem's official curator.
178                      curator => $curator,                      curator => $curator,
179                      # General notes about the subsystem.                      # General notes about the subsystem.
# Line 163  Line 190 
190                      roles => \@roles,                      roles => \@roles,
191                      # Map of PEG IDs to cluster numbers.                      # Map of PEG IDs to cluster numbers.
192                      colorHash => {},                      colorHash => {},
193                        # Map of abbreviations to role names.
194                        abbrHash => \%abbrHash,
195                        # Map of auxiliary rols.
196                        auxHash => \%auxHash,
197                      # Map of role IDs to reactions.                      # Map of role IDs to reactions.
198                      reactionHash => \%reactionHash,                      reactionHash => \%reactionHash,
199                        # Version number.
200                        version => $version,
201                  };                  };
202          # Bless and return it.          # Bless and return it.
203          bless $retVal, $class;          bless $retVal, $class;
# Line 172  Line 205 
205      return $retVal;      return $retVal;
206  }  }
207    
208    =head3 is_aux_role
209    
210        my $flag = $sub->is_aux_role($roleID);
211    
212    Return TRUE if the specified role is auxiliary to this subsystem, FALSE
213    if it is essential to it.
214    
215    =over 4
216    
217    =item roleID
218    
219    ID of the relevant role.
220    
221    =item RETURN
222    
223    Returns TRUE if the specified role is auxiliary, else FALSE.
224    
225    =back
226    
227    =cut
228    
229    sub is_aux_role {
230        # Get the parameters.
231        my ($self, $roleID) = @_;
232        # Declare the return variable.
233        my $retVal = $self->{auxHash}->{$roleID};
234        # Return the result.
235        return $retVal;
236    }
237    
238    
239    =head3 get_row
240    
241        my $rowData = $sub->get_row($rowIndex);
242    
243    Return the specified row in the subsystem spreadsheet. The row consists
244    of a list of lists. Each position in the major list represents the role
245    for that position, and contains a list of the IDs for the features that
246    perform the role.
247    
248    =over 4
249    
250    =item rowIndex
251    
252    Index of the row to return. A row contains data for a single genome.
253    
254    =item RETURN
255    
256    Returns a reference to a list of lists. Each element in the list represents
257    a spreadsheet column (role) and contains a list of features that perform the
258    role.
259    
260    =back
261    
262    =cut
263    
264    sub get_row {
265        # Get the parameters.
266        my ($self, $rowIndex) = @_;
267        # Get the genome ID for the specified row's genome.
268        my $genomeID = $self->{genomes}->[$rowIndex]->[0];
269        # Read the row from the database. We won't get exactly what we want. Instead, we'll
270        # get a list of triplets, each consisting of a role name, a feature ID, and a cluster
271        # number. We need to convert this into a list of lists and stash the clustering information
272        # in the color hash.
273        my @rowData = $self->{sprout}->GetAll([qw(Subsystem HasSSCell IsGenomeOf IsRoleOf ContainsFeature)],
274                                              "Subsystem(id) = ? AND IsGenomeOf(from-link) = ?",
275                                              [$self->{name}, $genomeID],
276                                              [qw(IsRoleOf(from-link) ContainsFeature(to-link)
277                                                  ContainsFeature(cluster-number))]);
278        # Now we do the conversion. We must first create an array of empty lists, one per
279        # row index.
280        my @retVal = map { [] } @{$self->{roles}};
281        # Get the hash for converting role IDs to role indexes.
282        my $roleHash = $self->{roleHash};
283        # Now we stash all the feature IDs in the appropriate columns of the row list.
284        for my $rowDatum (@rowData) {
285            # Get the role ID, the peg ID, and the cluster number.
286            my ($role, $peg, $cluster) = @{$rowDatum};
287            # Put the peg in the role's peg list.
288            push @{$retVal[$roleHash->{$role}]}, $peg;
289            # Put the cluster number in the color hash.
290            $self->{colorHash}->{$peg} = $cluster;
291        }
292        # Return the result.
293        return \@retVal;
294    }
295    
296    =head3 get_roles_for_genome
297    
298        my @roles = $sub->get_roles_for_genome($genome_id);
299    
300    Return a list of the roles in this subsystem that have nonempty
301    spreadsheet cells for the given genome.
302    
303    =over 4
304    
305    =item genome_id
306    
307    ID of the relevant genome.
308    
309    =item RETURN
310    
311    Returns a list of role IDs.
312    
313    =back
314    
315    =cut
316    
317    sub get_roles_for_genome {
318        # Get the parameters.
319        my ($self, $genome_id) = @_;
320        # This next statement gets all of the nonempty cells for the genome's row and memorizes
321        # the roles by rolling them into a hash. The query connects four relationship tables on
322        # a single common key-- the spreadsheet cell ID. The IsGenomeOf table insures the cell is for the
323        # correct genome. The HasSSCell table insures that it belongs to the correct subsystem. The
324        # ContainsFeature table insures that it contains at least one feature. Finally, IsRoleOf tells
325        # us the cell's role. If a cell has more than one feature, the result list from the query will return
326        # one instance of the role for every distinct feature. The hash collapses the duplicates automatically.
327        my %retVal = map { $_ => 1 } $self->{sprout}->GetFlat([qw(ContainsFeature HasSSCell IsGenomeOf IsRoleOf)],
328                                                              "HasSSCell(from-link) = ? AND IsGenomeOf(from-link) = ?",
329                                                              [$self->{name}, $genome_id], 'IsRoleOf(from-link)');
330        # Return the result.
331        return keys %retVal;
332    }
333    
334    =head3 get_abbr_for_role
335    
336        my $abbr = $sub->get_abbr_for_role($name);
337    
338    Get this subsystem's abbreviation for the specified role.
339    
340    =over 4
341    
342    =item name
343    
344    Name of the relevant role.
345    
346    =item RETURN
347    
348    Returns the abbreviation for the role. Each subsystem has its own abbreviation
349    system; the abbreviations make it easier to display the subsystem spreadsheet.
350    
351    =back
352    
353    =cut
354    
355    sub get_abbr_for_role {
356        # Get the parameters.
357        my ($self, $name) = @_;
358        # Get the index for this role.
359        my $idx = $self->get_role_index($name);
360        # Return the abbreviation.
361        return $self->get_role_abbr($idx);
362    }
363    
364    =head3 get_subsetC
365    
366        my @columns = $sub->get_subsetC($subsetName);
367    
368    Return a list of the column numbers for the columns in the named role
369    subset.
370    
371    =over 4
372    
373    =item subsetName
374    
375    Name of the subset whose columns are desired.
376    
377    =item RETURN
378    
379    Returns a list of the indices for the columns in the named subset.
380    
381    =back
382    
383    =cut
384    
385    sub get_subsetC {
386        # Get the parameters.
387        my ($self, $subsetName) = @_;
388        # Get the roles in the subset.
389        my @roles = $self->get_subsetC_roles($subsetName);
390        # Convert them to indices.
391        my $roleHash = $self->{roleHash};
392        my @retVal = map { $roleHash->{$_} } @roles;
393        # Return the result.
394        return @retVal;
395    }
396    
397  =head3 get_genomes  =head3 get_genomes
398    
399  C<< my @genomeList = $sub->get_genomes(); >>      my @genomeList = $sub->get_genomes();
400    
401  Return a list of the genome IDs for this subsystem. Each genome corresponds to a row  Return a list of the genome IDs for this subsystem. Each genome corresponds to a row
402  in the subsystem spreadsheet. Indexing into this list returns the ID of the genome  in the subsystem spreadsheet. Indexing into this list returns the ID of the genome
# Line 194  Line 416 
416    
417  =head3 get_variant_code  =head3 get_variant_code
418    
419  C<< my $code = $sub->get_variant_code($gidx); >>      my $code = $sub->get_variant_code($gidx);
420    
421  Return the variant code for the specified genome. Each subsystem has multiple  Return the variant code for the specified genome. Each subsystem has multiple
422  variants which involve slightly different chemical reactions, and each variant  variants which involve slightly different chemical reactions, and each variant
# Line 220  Line 442 
442      my ($self, $gidx) = @_;      my ($self, $gidx) = @_;
443      # Extract the variant code for the specified row index. It is the second      # Extract the variant code for the specified row index. It is the second
444      # element of the tuple from the "genomes" member.      # element of the tuple from the "genomes" member.
445      my $retVal = $self->{genomes}->{$gidx}->[1];      my $retVal = $self->{genomes}->[$gidx]->[1];
446      return $retVal;      return $retVal;
447  }  }
448    
449  =head3 get_curator  =head3 get_curator
450    
451  C<< my $userName = $sub->get_curator(); >>      my $userName = $sub->get_curator();
452    
453  Return the name of this subsystem's official curator.  Return the name of this subsystem's official curator.
454    
# Line 241  Line 463 
463    
464  =head3 get_notes  =head3 get_notes
465    
466  C<< my $text = $sub->get_notes(); >>      my $text = $sub->get_notes();
467    
468  Return the descriptive notes for this subsystem.  Return the descriptive notes for this subsystem.
469    
# Line 254  Line 476 
476      return $self->{notes};      return $self->{notes};
477  }  }
478    
479    =head3 get_description
480    
481        my $text = $sub->get_description();
482    
483    Return the description for this subsystem.
484    
485    =cut
486    
487    sub get_description
488    {
489        my($self) = @_;
490        return $self->{description};
491    }
492    
493  =head3 get_roles  =head3 get_roles
494    
495  C<< my @roles = $sub->get_roles(); >>      my @roles = $sub->get_roles();
496    
497  Return a list of the subsystem's roles. Each role corresponds to a column  Return a list of the subsystem's roles. Each role corresponds to a column
498  in the subsystem spreadsheet. The list entry at a specified position in  in the subsystem spreadsheet. The list entry at a specified position in
# Line 275  Line 511 
511    
512  =head3 get_reactions  =head3 get_reactions
513    
514  C<< my $reactHash = $sub->get_reactions(); >>      my $reactHash = $sub->get_reactions();
515    
516  Return a reference to a hash that maps each role ID to a list of the reactions  Return a reference to a hash that maps each role ID to a list of the reactions
517  catalyzed by the role.  catalyzed by the role.
# Line 291  Line 527 
527    
528  =head3 get_subset_namesC  =head3 get_subset_namesC
529    
530  C<< my @subsetNames = $sub->get_subset_namesC(); >>      my @subsetNames = $sub->get_subset_namesC();
531    
532  Return a list of the names for all the column (role) subsets. Given a subset  Return a list of the names for all the column (role) subsets. Given a subset
533  name, you can use the L</get_subsetC_roles> method to get the roles in the  name, you can use the L</get_subsetC_roles> method to get the roles in the
# Line 313  Line 549 
549      return @retVal;      return @retVal;
550  }  }
551    
552    =head3 get_subset_names
553    
554        my @subsetNames = $sub->get_subset_names();
555    
556    Return the names of the column subsets.
557    
558    =cut
559    
560    sub get_subset_names{
561        # Get the parameters.
562        my ($self) = @_;
563        # Return the result.
564        return $self->get_subset_namesC();
565    }
566    
567  =head3 get_role_abbr  =head3 get_role_abbr
568    
569  C<< my $abbr = $sub->get_role_abbr($ridx); >>      my $abbr = $sub->get_role_abbr($ridx);
570    
571  Return the abbreviation for the role in the specified column. The abbreviation  Return the abbreviation for the role in the specified column. The abbreviation
572  is a shortened identifier that is not necessarily unique, but is more likely to  is a shortened identifier that is not necessarily unique, but is more likely to
# Line 344  Line 595 
595      return $retVal;      return $retVal;
596  }  }
597    
598    
599    =head3 get_hope_reactions_for_genome
600    
601        my %ss_reactions = $subsys->get_hope_reactions_for_genome($genome);
602    
603    This method returns a hash that maps reactions to the pegs that catalyze
604    them for the specified genome. For each role in the subsystem, the pegs
605    are computed, and these are attached to the reactions for the role.
606    
607    =over 4
608    
609    =item genome
610    
611    ID of the genome whose reactions are to be put into the hash.
612    
613    =item RETURN
614    
615    Returns a hash mapping reactions in the subsystem to pegs in the
616    specified genome, or C<undef> if the genome is not found in the
617    subsystem.
618    
619    =back
620    
621    =cut
622    
623    sub get_hope_reactions_for_genome {
624        ##TODO
625        my($self, $genome) = @_;
626        my $index = $self->{genome_index}->{$genome};
627        if (defined $index) {
628            my @roles = $self->get_roles;
629            my %hope_reactions = $self->get_hope_reactions;
630    
631            my %ss_reactions;
632    
633            foreach my $role (@roles)
634            {
635                my @peg_list = $self->get_pegs_from_cell($genome,$role);
636    
637                if (defined $hope_reactions{$role} && scalar @peg_list > 0)
638    
639                {
640                    foreach my $reaction (@{$hope_reactions{$role}})
641                    {
642                        push @{$ss_reactions{$reaction}}, @peg_list;
643                    }
644                }
645            }
646    
647            return %ss_reactions;
648        }
649        else {
650            return undef;
651        }
652    }
653    
654    
655    =head3 get_hope_additional_reactions
656    
657        my %ss_reactions = $subsys->get_hope_additional_reactions($scenario_name);
658    
659    Return a list of the additional reactions for the specified scenario.
660    
661    =over 4
662    
663    =item scenario_name
664    
665    Name of the scenario whose additional reactions are desired.
666    
667    =item RETURN
668    
669    Returns a list of the additional reactions attached to the named scenario.
670    
671    =back
672    
673    =cut
674    
675    sub get_hope_additional_reactions
676    {
677        my($self,$scenario_name) = @_;
678        Trace("Hope additional reactions not available in NMPDR.") if T(0);  ##HACK
679        my @retVal;
680        return @retVal;
681    }
682    
683    
684    =head3 get_hope_reactions
685    
686        my %reactionHash = $subsys->get_hope_reactions();
687    
688    Return a hash mapping the roles of this subsystem to the EC numbers for
689    the reactions used in scenarios (if any). It may return an empty hash
690    if the Hope reactions are not yet known.
691    
692    =cut
693    
694    sub get_hope_reactions {
695        # Get the parameters.
696        my ($self) = @_;
697        # Try to get the hope reactions from the object.
698        my $retVal = $self->{hopeReactions};
699        if (! defined($retVal)) {
700            # They do not exist, so we must create them.
701            $retVal = FIGRules::GetHopeReactions($self, $self->{dir}); ##HACK
702            # Insure we have it if we need it again.
703            $self->{hopeReactions} = $retVal;
704        }
705        # Return the result.
706        return %{$retVal};
707    }
708    
709    =head3 get_hope_reaction_notes
710    
711        my %roleHash = $sub->get_hope_reaction_notes();
712    
713    Return a hash mapping the roles of the subsystem to any existing notes
714    about the relevant reactions.
715    
716    =cut
717    
718    sub get_hope_reaction_notes {
719        # Get the parameters.
720        my ($self) = @_;
721        # Declare the return variable.
722        my %retVal;
723        ##TODO: Code
724        # Return the result.
725        return %retVal;
726    }
727    
728    =head3 get_hope_reaction_note
729    
730        my $note = $sub->get_hope_reaction_note($role);
731    
732    Return the text note about the curation of the scenario reactions
733    relating to this role.
734    
735    =over 4
736    
737    =item role
738    
739    ##TODO: role description
740    
741    =item RETURN
742    
743    ##TODO: return value description
744    
745    =back
746    
747    =cut
748    
749    sub get_hope_reaction_note {
750        # Get the parameters.
751        my ($self, $role) = @_;
752        # Declare the return variable.
753        my $retVal;
754        ##TODO: Code
755        # Return the result.
756        return $retVal;
757    }
758    
759  =head3 get_role_index  =head3 get_role_index
760    
761  C<< my $idx = $sub->get_role_index($role); >>      my $idx = $sub->get_role_index($role);
762    
763  Return the column index for the role with the specified ID.  Return the column index for the role with the specified ID.
764    
# Line 374  Line 786 
786    
787  =head3 get_subsetC_roles  =head3 get_subsetC_roles
788    
789  C<< my @roles = $sub->get_subsetC_roles($subname); >>      my @roles = $sub->get_subsetC_roles($subname);
790    
791  Return the names of the roles contained in the specified role (column) subset.  Return the names of the roles contained in the specified role (column) subset.
792    
# Line 412  Line 824 
824    
825  =head3 get_genome_index  =head3 get_genome_index
826    
827  C<< my $idx = $sub->get_genome_index($genome); >>      my $idx = $sub->get_genome_index($genome);
828    
829  Return the row index for the genome with the specified ID.  Return the row index for the genome with the specified ID.
830    
# Line 441  Line 853 
853    
854  =head3 get_cluster_number  =head3 get_cluster_number
855    
856  C<< my $number = $sub->get_cluster_number($pegID); >>      my $number = $sub->get_cluster_number($pegID);
857    
858  Return the cluster number for the specified PEG, or C<-1> if the  Return the cluster number for the specified PEG, or C<-1> if the
859  cluster number for the PEG is unknown or it is not clustered.  cluster number for the PEG is unknown or it is not clustered.
# Line 457  Line 869 
869  =item pegID  =item pegID
870    
871  ID of the PEG whose cluster number is desired.  ID of the PEG whose cluster number is desired.
872  TODO: items  
873    =item RETURN
874    
875    Returns the appropriate cluster number.
876    
877  =back  =back
878    
# Line 478  Line 893 
893    
894  =head3 get_pegs_from_cell  =head3 get_pegs_from_cell
895    
896  C<< my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr); >>      my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr);
897    
898  Return a list of the peg IDs for the features in the specified spreadsheet cell.  Return a list of the peg IDs for the features in the specified spreadsheet cell.
899    
# Line 528  Line 943 
943          }          }
944      }      }
945      # Construct the spreadsheet cell ID from the information we have.      # Construct the spreadsheet cell ID from the information we have.
946      my $cellID = $self->{name} . ":$genomeID:$colIdx";      my $cellID = $sprout->DigestKey($self->{name} . ":$genomeID:$colIdx");
947      # Get the list of PEG IDs and cluster numbers for the indicated cell.      # Get the list of PEG IDs and cluster numbers for the indicated cell.
948      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',
949                                    [$cellID], ['ContainsFeature(to-link)',                                    [$cellID], ['ContainsFeature(to-link)',
# Line 545  Line 960 
960      return @retVal;      return @retVal;
961  }  }
962    
963  1;  =head3 get_subsetR
964    
965        my @genomes = $sub->get_subsetR($subName);
966    
967    Return the genomes in the row subset indicated by the specified subset name.
968    
969    =over 4
970    
971    =item subName
972    
973    Name of the desired row subset, or C<All> to get all of the rows.
974    
975    =item RETURN
976    
977    Returns a list of genome IDs corresponding to the named subset.
978    
979    =back
980    
981    =cut
982    
983    sub get_subsetR {
984        # Get the parameters.
985        my ($self, $subName) = @_;
986        # Look for the specified row subset in the database. A row subset is identified using
987        # the subsystem name and the subset name. The special subset "All" is actually
988        # represented in the database, so we don't need to check for it.
989        my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
990                                            ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
991        return @rows;
992    }
993    
994    =head3 get_diagrams
995    
996        my @list = $sub->get_diagrams();
997    
998    Return a list of the diagrams associated with this subsystem. Each diagram
999    is represented in the return list as a 4-tuple C<[diagram_id, diagram_name,
1000    page_link, img_link]> where
1001    
1002    =over 4
1003    
1004    =item diagram_id
1005    
1006    ID code for this diagram.
1007    
1008    =item diagram_name
1009    
1010    Displayable name of the diagram.
1011    
1012    =item page_link
1013    
1014    URL of an HTML page containing information about the diagram.
1015    
1016    =item img_link
1017    
1018    URL of an HTML page containing an image for the diagram.
1019    
1020    =back
1021    
1022    Note that the URLs are in fact for CGI scripts with parameters that point them
1023    to the correct place. Though Sprout has diagram information in it, it has
1024    no relationship to the diagrams displayed in SEED, so the work is done entirely
1025    on the SEED side.
1026    
1027    =cut
1028    
1029    sub get_diagrams {
1030        # Get the parameters.
1031        my ($self) = @_;
1032        # Get the diagram IDs.
1033        my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir});
1034        Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3);
1035        # Create the return variable.
1036        my @retVal = ();
1037        # Loop through the diagram IDs.
1038        for my $diagramID (@diagramIDs) {
1039            Trace("Processing diagram $diagramID.") if T(3);
1040            my ($name, $link, $imgLink) = $self->get_diagram($diagramID);
1041            Trace("Diagram $name URLs are \"$link\" and \"$imgLink\".") if T(3);
1042            push @retVal, [$diagramID, $name, $link, $imgLink];
1043        }
1044        # Return the result.
1045        return @retVal;
1046    }
1047    
1048    =head3 get_diagram
1049    
1050        my ($name, $pageURL, $imgURL) = $sub->get_diagram($id);
1051    
1052    Get the information (if any) for the specified diagram. The diagram corresponds
1053    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
1054    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
1055    where I<$dir> is the subsystem directory. The diagram's name is extracted from
1056    a tiny file containing the name, and then the links are computed using the
1057    subsystem name and the diagram ID. The parameters are as follows.
1058    
1059    =over 4
1060    
1061    =item id
1062    
1063    ID code for the desired diagram.
1064    
1065    =item RETURN
1066    
1067    Returns a three-element list. The first element is the diagram name, the second
1068    a URL for displaying information about the diagram, and the third a URL for
1069    displaying the diagram image.
1070    
1071    =back
1072    
1073    =cut
1074    
1075    sub get_diagram {
1076        my($self, $id) = @_;
1077        my $name = Subsystem::GetDiagramName($self->{dir}, $id);
1078        my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self, $self->{name}, $id, 1);
1079        return($name, $link, $img_link);
1080    }
1081    
1082    
1083    =head3 get_diagram_html_file
1084    
1085        my $fileName = $sub->get_diagram_html_file($id);
1086    
1087    Get the HTML file (if any) for the specified diagram. The diagram corresponds
1088    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
1089    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
1090    where I<$dir> is the subsystem directory. If an HTML file exists, it will be
1091    named C<diagram.html> in the diagram directory.  The parameters are as follows.
1092    
1093    =over 4
1094    
1095    =item id
1096    
1097    ID code for the desired diagram.
1098    
1099    =item RETURN
1100    
1101    Returns the name of an HTML diagram file, or C<undef> if no such file exists.
1102    
1103    =back
1104    
1105    =cut
1106    
1107    sub get_diagram_html_file {
1108        my ($self, $id) = @_;
1109        my $retVal;
1110        my $ddir = "$self->{dir}/diagrams/$id";
1111        if (-d $ddir) {
1112            my $html = "$ddir/diagram.html";
1113            if (-f $html) {
1114                $retVal = $html;
1115            }
1116        }
1117        return $retVal;
1118    }
1119    
1120    =head3 is_new_diagram
1121    
1122        my $flag = $sub->is_new_diagram($id);
1123    
1124    Return TRUE if the specified diagram is in the new format, else FALSE.
1125    
1126    =over 4
1127    
1128    =item id
1129    
1130    ID code (e.g. C<d03>) of the relevant diagram.
1131    
1132    =item RETURN
1133    
1134    Returns TRUE if the diagram is in the new format, else FALSE.
1135    
1136    =back
1137    
1138    =cut
1139    
1140    sub is_new_diagram {
1141      my ($self, $id) = @_;
1142    
1143      my $image_map = $self->get_diagram_html_file($id);
1144      if ($image_map) {
1145        Trace("Image map found for diagram $id at $image_map.") if T(3);
1146        Open(\*IN, "<$image_map");
1147        my $header = <IN>;
1148        close(IN);
1149    
1150        if ($header =~ /\<map name=\"GraffleExport\"\>/) {
1151          return 1;
1152        }
1153      }
1154    
1155      return undef;
1156    }
1157    
1158    =head3 get_role_from_abbr
1159    
1160        my $roleName = $sub->get_role_from_abbr($abbr);
1161    
1162    Return the role name corresponding to an abbreviation.
1163    
1164    =over 4
1165    
1166    =item abbr
1167    
1168    Abbreviation name of the relevant role.
1169    
1170    =item RETURN
1171    
1172    Returns the full name of the specified role.
1173    
1174    =back
1175    
1176    =cut
1177    
1178    sub get_role_from_abbr {
1179        # Get the parameters.
1180        my($self, $abbr) = @_;
1181        # Get the role name from the abbreviation hash.
1182        my $retVal = $self->{abbrHash}->{$abbr};
1183        # Check for a case incompatability.
1184        if (! defined $retVal) {
1185            $retVal = $self->{abbrHash}->{lcfirst $abbr};
1186        }
1187        # Return the result.
1188        return $retVal;
1189    }
1190    
1191    
1192    =head3 get_name
1193    
1194        my $name = $sub->get_name();
1195    
1196    Return the name of this subsystem.
1197    
1198    =cut
1199    
1200    sub get_name {
1201        # Get the parameters.
1202        my ($self) = @_;
1203        # Return the result.
1204        return $self->{name};
1205    }
1206    
1207    =head3 open_diagram_image
1208    
1209        my ($type, $fh) = $sub->open_diagram_image($id);
1210    
1211    Open a diagram's image file and return the type and file handle.
1212    
1213    =over 4
1214    
1215    =item id
1216    
1217    ID of the desired diagram
1218    
1219    =item RETURN
1220    
1221    Returns a 2-tuple containing the diagram's MIME type and an open filehandle
1222    for the diagram's data. If the diagram does not exist, the type will be
1223    returned as <undef>.
1224    
1225    =back
1226    
1227    =cut
1228    
1229    sub open_diagram_image {
1230        # Get the parameters.
1231        my ($self, $id) = @_;
1232        # Declare the return variables.
1233        my ($type, $fh);
1234        # Get the diagram directory.
1235        my $img_base = "$self->{dir}/diagrams/$id/diagram";
1236        # Get a list of file extensions and types.
1237        my %types = (png => "image/png",
1238                     gif => "image/gif",
1239                     jpg => "image/jpeg");
1240        # This is my new syntax for the for-each-while loop.
1241        # We loop until we run out of keys or come up with a type value.
1242        for my $ext (keys %types) { last if (defined $type);
1243            my $myType = $types{$ext};
1244            # Compute a file name for this diagram.
1245            my $file = "$img_base.$ext";
1246            # If it exists, try to open it.
1247            if (-f $file) {
1248                $fh = Open(undef, "<$file");
1249                $type = $myType;
1250            }
1251        }
1252        # Return the result.
1253        return ($type, $fh);
1254    }
1255    
1256    
1257    1;

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.18

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3