[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.4, Mon Nov 28 22:52:11 2005 UTC revision 1.20, Wed Oct 15 11:46:57 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          # Now we need to create the role ID directory and the reaction hash.                                                   'OccursInSubsystem(auxiliary)']);
141          # The role ID directory maps role IDs and their abbreviations to column numbers.          # Now we need to create the role ID directory, which maps role IDs and their
142          # The reaction hash maps a role ID to a list of the IDs for the reactions it          # abbreviations to column numbers.
         # catalyzes.  
143          my %roleHash = ();          my %roleHash = ();
144          my %reactionHash = ();          my %abbrHash = ();
145            my %auxHash = ();
146          for ($idx = 0; $idx <= $#roles; $idx++) {          for ($idx = 0; $idx <= $#roles; $idx++) {
147              # Get the role ID and abbreviation for this column's role.              # Get the role ID, aux flag, and abbreviation for this column's role.
148              my ($roleID, $abbr) = @{$roles[$idx]};              my ($roleID, $abbr, $aux) = @{$roles[$idx]};
149              # Put them both in the role directory.              # Put the ID and abbreviation in the role directory.
150              $roleHash{$roleID} = $idx;              $roleHash{$roleID} = $idx;
151              $roleHash{$abbr} = $idx;              $roleHash{$abbr} = $idx;
152              # Get this role's reactions.              # Put the aux flag in the aux hash.
153              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',              $auxHash{$roleID} = $aux;
154                                               [$roleID], 'Catalyzes(to-link)');              # Put the full name in the abbreviation directory.
155              # Put them in the reaction hash.              $abbrHash{$abbr} = $roleID;
             if (@reactions > 0) {  
                 $reactionHash{$roleID} = \@reactions;  
             }  
156          }          }
157            # Find the subsystem directory.
158            my $subDir = Subsystem::get_dir_from_name($subName);
159            Trace("Subsystem directory is $subDir.") if T(3);
160          # Create the subsystem object.          # Create the subsystem object.
161          $retVal = {          $retVal = {
162                      # Name of the subsystem. This is needed for any further database                      # Name of the subsystem. This is needed for any further database
163                      # accesses required.                      # accesses required.
164                      name => $subName,                      name => $subName,
165                        # Directory root for diagram and image files.
166                        dir => $subDir,
167                      # Name of the subsystem's official curator.                      # Name of the subsystem's official curator.
168                      curator => $curator,                      curator => $curator,
169                      # General notes about the subsystem.                      # General notes about the subsystem.
# Line 165  Line 180 
180                      roles => \@roles,                      roles => \@roles,
181                      # Map of PEG IDs to cluster numbers.                      # Map of PEG IDs to cluster numbers.
182                      colorHash => {},                      colorHash => {},
183                        # Map of abbreviations to role names.
184                        abbrHash => \%abbrHash,
185                        # Map of auxiliary rols.
186                        auxHash => \%auxHash,
187                      # Map of role IDs to reactions.                      # Map of role IDs to reactions.
188                      reactionHash => \%reactionHash,                      reactionHash => undef,
189                        # Version number.
190                        version => $version,
191                  };                  };
192          # Bless and return it.          # Bless and return it.
193          bless $retVal, $class;          bless $retVal, $class;
# Line 174  Line 195 
195      return $retVal;      return $retVal;
196  }  }
197    
198    =head3 is_aux_role
199    
200        my $flag = $sub->is_aux_role($roleID);
201    
202    Return TRUE if the specified role is auxiliary to this subsystem, FALSE
203    if it is essential to it.
204    
205    =over 4
206    
207    =item roleID
208    
209    ID of the relevant role.
210    
211    =item RETURN
212    
213    Returns TRUE if the specified role is auxiliary, else FALSE.
214    
215    =back
216    
217    =cut
218    
219    sub is_aux_role {
220        # Get the parameters.
221        my ($self, $roleID) = @_;
222        # Declare the return variable.
223        my $retVal = $self->{auxHash}->{$roleID};
224        # Return the result.
225        return $retVal;
226    }
227    
228    
229    =head3 get_row
230    
231        my $rowData = $sub->get_row($rowIndex);
232    
233    Return the specified row in the subsystem spreadsheet. The row consists
234    of a list of lists. Each position in the major list represents the role
235    for that position, and contains a list of the IDs for the features that
236    perform the role.
237    
238    =over 4
239    
240    =item rowIndex
241    
242    Index of the row to return. A row contains data for a single genome.
243    
244    =item RETURN
245    
246    Returns a reference to a list of lists. Each element in the list represents
247    a spreadsheet column (role) and contains a list of features that perform the
248    role.
249    
250    =back
251    
252    =cut
253    
254    sub get_row {
255        # Get the parameters.
256        my ($self, $rowIndex) = @_;
257        # Get the genome ID for the specified row's genome.
258        my $genomeID = $self->{genomes}->[$rowIndex]->[0];
259        # Read the row from the database. We won't get exactly what we want. Instead, we'll
260        # get a list of triplets, each consisting of a role name, a feature ID, and a cluster
261        # number. We need to convert this into a list of lists and stash the clustering information
262        # in the color hash.
263        my @rowData = $self->{sprout}->GetAll([qw(Subsystem HasSSCell IsGenomeOf IsRoleOf ContainsFeature)],
264                                              "Subsystem(id) = ? AND IsGenomeOf(from-link) = ?",
265                                              [$self->{name}, $genomeID],
266                                              [qw(IsRoleOf(from-link) ContainsFeature(to-link)
267                                                  ContainsFeature(cluster-number))]);
268        # Now we do the conversion. We must first create an array of empty lists, one per
269        # row index.
270        my @retVal = map { [] } @{$self->{roles}};
271        # Get the hash for converting role IDs to role indexes.
272        my $roleHash = $self->{roleHash};
273        # Now we stash all the feature IDs in the appropriate columns of the row list.
274        for my $rowDatum (@rowData) {
275            # Get the role ID, the peg ID, and the cluster number.
276            my ($role, $peg, $cluster) = @{$rowDatum};
277            # Put the peg in the role's peg list.
278            push @{$retVal[$roleHash->{$role}]}, $peg;
279            # Put the cluster number in the color hash.
280            $self->{colorHash}->{$peg} = $cluster;
281        }
282        # Return the result.
283        return \@retVal;
284    }
285    
286    =head3 get_roles_for_genome
287    
288        my @roles = $sub->get_roles_for_genome($genome_id);
289    
290    Return a list of the roles in this subsystem that have nonempty
291    spreadsheet cells for the given genome.
292    
293    =over 4
294    
295    =item genome_id
296    
297    ID of the relevant genome.
298    
299    =item RETURN
300    
301    Returns a list of role IDs.
302    
303    =back
304    
305    =cut
306    
307    sub get_roles_for_genome {
308        # Get the parameters.
309        my ($self, $genome_id) = @_;
310        # This next statement gets all of the nonempty cells for the genome's row and memorizes
311        # the roles by rolling them into a hash. The query connects four relationship tables on
312        # a single common key-- the spreadsheet cell ID. The IsGenomeOf table insures the cell is for the
313        # correct genome. The HasSSCell table insures that it belongs to the correct subsystem. The
314        # ContainsFeature table insures that it contains at least one feature. Finally, IsRoleOf tells
315        # us the cell's role. If a cell has more than one feature, the result list from the query will return
316        # one instance of the role for every distinct feature. The hash collapses the duplicates automatically.
317        my %retVal = map { $_ => 1 } $self->{sprout}->GetFlat([qw(ContainsFeature HasSSCell IsGenomeOf IsRoleOf)],
318                                                              "HasSSCell(from-link) = ? AND IsGenomeOf(from-link) = ?",
319                                                              [$self->{name}, $genome_id], 'IsRoleOf(from-link)');
320        # Return the result.
321        return keys %retVal;
322    }
323    
324    =head3 get_abbr_for_role
325    
326        my $abbr = $sub->get_abbr_for_role($name);
327    
328    Get this subsystem's abbreviation for the specified role.
329    
330    =over 4
331    
332    =item name
333    
334    Name of the relevant role.
335    
336    =item RETURN
337    
338    Returns the abbreviation for the role. Each subsystem has its own abbreviation
339    system; the abbreviations make it easier to display the subsystem spreadsheet.
340    
341    =back
342    
343    =cut
344    
345    sub get_abbr_for_role {
346        # Get the parameters.
347        my ($self, $name) = @_;
348        # Get the index for this role.
349        my $idx = $self->get_role_index($name);
350        # Return the abbreviation.
351        return $self->get_role_abbr($idx);
352    }
353    
354    =head3 get_subsetC
355    
356        my @columns = $sub->get_subsetC($subsetName);
357    
358    Return a list of the column numbers for the columns in the named role
359    subset.
360    
361    =over 4
362    
363    =item subsetName
364    
365    Name of the subset whose columns are desired.
366    
367    =item RETURN
368    
369    Returns a list of the indices for the columns in the named subset.
370    
371    =back
372    
373    =cut
374    
375    sub get_subsetC {
376        # Get the parameters.
377        my ($self, $subsetName) = @_;
378        # Get the roles in the subset.
379        my @roles = $self->get_subsetC_roles($subsetName);
380        # Convert them to indices.
381        my $roleHash = $self->{roleHash};
382        my @retVal = map { $roleHash->{$_} } @roles;
383        # Return the result.
384        return @retVal;
385    }
386    
387  =head3 get_genomes  =head3 get_genomes
388    
389  C<< my @genomeList = $sub->get_genomes(); >>      my @genomeList = $sub->get_genomes();
390    
391  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
392  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 196  Line 406 
406    
407  =head3 get_variant_code  =head3 get_variant_code
408    
409  C<< my $code = $sub->get_variant_code($gidx); >>      my $code = $sub->get_variant_code($gidx);
410    
411  Return the variant code for the specified genome. Each subsystem has multiple  Return the variant code for the specified genome. Each subsystem has multiple
412  variants which involve slightly different chemical reactions, and each variant  variants which involve slightly different chemical reactions, and each variant
# Line 222  Line 432 
432      my ($self, $gidx) = @_;      my ($self, $gidx) = @_;
433      # 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
434      # element of the tuple from the "genomes" member.      # element of the tuple from the "genomes" member.
435      my $retVal = $self->{genomes}->{$gidx}->[1];      my $retVal = $self->{genomes}->[$gidx]->[1];
436      return $retVal;      return $retVal;
437  }  }
438    
439  =head3 get_curator  =head3 get_curator
440    
441  C<< my $userName = $sub->get_curator(); >>      my $userName = $sub->get_curator();
442    
443  Return the name of this subsystem's official curator.  Return the name of this subsystem's official curator.
444    
# Line 243  Line 453 
453    
454  =head3 get_notes  =head3 get_notes
455    
456  C<< my $text = $sub->get_notes(); >>      my $text = $sub->get_notes();
457    
458  Return the descriptive notes for this subsystem.  Return the descriptive notes for this subsystem.
459    
# Line 256  Line 466 
466      return $self->{notes};      return $self->{notes};
467  }  }
468    
469    =head3 get_description
470    
471        my $text = $sub->get_description();
472    
473    Return the description for this subsystem.
474    
475    =cut
476    
477    sub get_description
478    {
479        my($self) = @_;
480        return $self->{description};
481    }
482    
483  =head3 get_roles  =head3 get_roles
484    
485  C<< my @roles = $sub->get_roles(); >>      my @roles = $sub->get_roles();
486    
487  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
488  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 277  Line 501 
501    
502  =head3 get_reactions  =head3 get_reactions
503    
504  C<< my $reactHash = $sub->get_reactions(); >>      my $reactHash = $sub->get_reactions();
505    
506  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
507  catalyzed by the role.  catalyzed by the role.
# Line 287  Line 511 
511  sub get_reactions {  sub get_reactions {
512      # Get the parameters.      # Get the parameters.
513      my ($self) = @_;      my ($self) = @_;
514      # Return the reaction hash member.      # Do we already have a reaction hash?
515      return $self->{reactionHash};      my $retVal = $self->{reactionHash};
516        if (! $retVal) {
517            # No, so we'll build it.
518            $retVal = {};
519            my $sprout = $self->{sprout};
520            for my $roleID ($self->get_roles()) {
521                # Get this role's reactions.
522                my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',
523                                                 [$roleID], 'Catalyzes(to-link)');
524                # Put them in the reaction hash.
525                if (@reactions > 0) {
526                    $retVal->{$roleID} = \@reactions;
527                }
528            }
529            # Save it for future use.
530            $self->{reactionHash} = $retVal;
531        }
532        # Return the reaction hash.
533        return $retVal;
534  }  }
535    
536  =head3 get_subset_namesC  =head3 get_subset_namesC
537    
538  C<< my @subsetNames = $sub->get_subset_namesC(); >>      my @subsetNames = $sub->get_subset_namesC();
539    
540  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
541  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 315  Line 557 
557      return @retVal;      return @retVal;
558  }  }
559    
560    =head3 get_subset_names
561    
562        my @subsetNames = $sub->get_subset_names();
563    
564    Return the names of the column subsets.
565    
566    =cut
567    
568    sub get_subset_names{
569        # Get the parameters.
570        my ($self) = @_;
571        # Return the result.
572        return $self->get_subset_namesC();
573    }
574    
575  =head3 get_role_abbr  =head3 get_role_abbr
576    
577  C<< my $abbr = $sub->get_role_abbr($ridx); >>      my $abbr = $sub->get_role_abbr($ridx);
578    
579  Return the abbreviation for the role in the specified column. The abbreviation  Return the abbreviation for the role in the specified column. The abbreviation
580  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 346  Line 603 
603      return $retVal;      return $retVal;
604  }  }
605    
606    
607    =head3 get_hope_reactions_for_genome
608    
609        my %ss_reactions = $subsys->get_hope_reactions_for_genome($genome);
610    
611    This method returns a hash that maps reactions to the pegs that catalyze
612    them for the specified genome. For each role in the subsystem, the pegs
613    are computed, and these are attached to the reactions for the role.
614    
615    =over 4
616    
617    =item genome
618    
619    ID of the genome whose reactions are to be put into the hash.
620    
621    =item RETURN
622    
623    Returns a hash mapping reactions in the subsystem to pegs in the
624    specified genome, or an empty hash if the genome is not found in the
625    subsystem.
626    
627    =back
628    
629    =cut
630    
631    sub get_hope_reactions_for_genome {
632        # Get the parameters.
633        my($self, $genome) = @_;
634        # Declare the return variable.
635        my %retVal;
636        # Look for the genome in our spreadsheet.
637        my $index = $self->get_genome_index($genome);
638        # Only proceed if we found it.
639        if (defined $index) {
640            # Extract the roles.
641            my @roles = $self->get_roles;
642            # Get the hope reaction hash. For each role, this gives us a list
643            # of reactions.
644            my %hope_reactions = $self->get_hope_reactions();
645            # Loop through the cells in this genome's role.
646            for my $role (@roles) {
647                # Get the features in this role's cell.
648                my @peg_list = $self->get_pegs_from_cell($genome,$role);
649                # Only proceed if we have hope reactions AND pegs for this role.
650                if (defined $hope_reactions{$role} && scalar @peg_list > 0) {
651                    # Loop through the reactions, pushing the pegs in this cell onto
652                    # the reaction's peg list.
653                    for my $reaction (@{$hope_reactions{$role}}) {
654                        push @{$retVal{$reaction}}, @peg_list;
655                    }
656                }
657            }
658        }
659        # Return the result.
660        return %retVal;
661    }
662    
663    
664    =head3 get_hope_additional_reactions
665    
666        my %ss_reactions = $subsys->get_hope_additional_reactions($scenario_name);
667    
668    Return a list of the additional reactions for the specified scenario.
669    
670    =over 4
671    
672    =item scenario_name
673    
674    Name of the scenario whose additional reactions are desired.
675    
676    =item RETURN
677    
678    Returns a list of the additional reactions attached to the named scenario.
679    
680    =back
681    
682    =cut
683    
684    sub get_hope_additional_reactions {
685        # Get the parameters.
686        my($self, $scenario_name) = @_;
687        # Ask the database for this scenario's additional reactions.
688        my @retVal = $self->{sprout}->GetFlat(['IncludesReaction'], "IncludesReaction(from-link) = ?",
689                                              [$scenario_name], 'IncludesReaction(to-link)');
690        return @retVal;
691    }
692    
693    
694    =head3 get_hope_reactions
695    
696        my %reactionHash = $subsys->get_hope_reactions();
697    
698    Return a hash mapping the roles of this subsystem to the EC numbers for
699    the reactions used in scenarios (if any). It may return an empty hash
700    if the Hope reactions are not yet known.
701    
702    =cut
703    
704    sub get_hope_reactions {
705        # Get the parameters.
706        my ($self) = @_;
707        # Try to get the hope reactions from the object.
708        my $retVal = $self->{hopeReactions};
709        if (! defined($retVal)) {
710            # They do not exist, so we must create them. Make a copy of the role-to-reaction
711            # hash.
712            my %hopeHash = %{$self->get_reactions()};
713            # Insure we have it if we need it again.
714            $retVal = \%hopeHash;
715            $self->{hopeReactions} = $retVal;
716        }
717        # Return the result.
718        return %{$retVal};
719    }
720    
721    =head3 get_hope_reaction_notes
722    
723        my %roleHash = $sub->get_hope_reaction_notes();
724    
725    Return a hash mapping the roles of the subsystem to any existing notes
726    about the relevant reactions.
727    
728    =cut
729    
730    sub get_hope_reaction_notes {
731        # Get the parameters.
732        my ($self) = @_;
733        # Declare the return variable.
734        my %retVal;
735        # Get the database object.
736        my $sprout = $self->{sprout};
737        # Get our name.
738        my $ssName = $self->{name};
739        # Loop through the roles, getting each role's hope notes.
740        for my $role ($self->get_roles()) {
741            my ($note) = $self->get_hop_reaction_note($role);
742            # If this role had a nonempty note, stuff it in the hash.
743            if ($note) {
744                $retVal{$role} = $note;
745            }
746        }
747        # Return the result.
748        return %retVal;
749    }
750    
751    =head3 get_hope_reaction_note
752    
753        my $note = $sub->get_hope_reaction_note($role);
754    
755    Return the text note about the curation of the scenario reactions
756    relating to this role.
757    
758    =over 4
759    
760    =item role
761    
762    ID of the role whose note is desired.
763    
764    =item RETURN
765    
766    Returns the relevant role's note for this subsystem's hope reactions, or FALSE (empty string
767    or undefined) if no such note was found.
768    
769    =back
770    
771    =cut
772    
773    sub get_hope_reaction_note {
774        # Get the parameters.
775        my ($self, $role) = @_;
776        # Ask the database for the note.
777        my ($retVal) = $self->{sprout}->GetFlat(['OccursInSubsystem'],
778                                                "OccursInSubsystem(from-link) = ? AND OccursInSubsystem(to-link) = ?",
779                                                [$role, $self->{name}], 'OccursInSubsystem(hope-reaction-note)');
780        # Return the result.
781        return $retVal;
782    }
783    
784  =head3 get_role_index  =head3 get_role_index
785    
786  C<< my $idx = $sub->get_role_index($role); >>      my $idx = $sub->get_role_index($role);
787    
788  Return the column index for the role with the specified ID.  Return the column index for the role with the specified ID.
789    
# Line 376  Line 811 
811    
812  =head3 get_subsetC_roles  =head3 get_subsetC_roles
813    
814  C<< my @roles = $sub->get_subsetC_roles($subname); >>      my @roles = $sub->get_subsetC_roles($subname);
815    
816  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.
817    
# Line 414  Line 849 
849    
850  =head3 get_genome_index  =head3 get_genome_index
851    
852  C<< my $idx = $sub->get_genome_index($genome); >>      my $idx = $sub->get_genome_index($genome);
853    
854  Return the row index for the genome with the specified ID.  Return the row index for the genome with the specified ID.
855    
# Line 443  Line 878 
878    
879  =head3 get_cluster_number  =head3 get_cluster_number
880    
881  C<< my $number = $sub->get_cluster_number($pegID); >>      my $number = $sub->get_cluster_number($pegID);
882    
883  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
884  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 483  Line 918 
918    
919  =head3 get_pegs_from_cell  =head3 get_pegs_from_cell
920    
921  C<< my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr); >>      my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr);
922    
923  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.
924    
# Line 533  Line 968 
968          }          }
969      }      }
970      # Construct the spreadsheet cell ID from the information we have.      # Construct the spreadsheet cell ID from the information we have.
971      my $cellID = $self->{name} . ":$genomeID:$colIdx";      my $cellID = $sprout->DigestKey($self->{name} . ":$genomeID:$colIdx");
972      # 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.
973      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',
974                                    [$cellID], ['ContainsFeature(to-link)',                                    [$cellID], ['ContainsFeature(to-link)',
# Line 550  Line 985 
985      return @retVal;      return @retVal;
986  }  }
987    
988    =head3 get_subsetR
989    
990        my @genomes = $sub->get_subsetR($subName);
991    
992    Return the genomes in the row subset indicated by the specified subset name.
993    
994    =over 4
995    
996    =item subName
997    
998    Name of the desired row subset, or C<All> to get all of the rows.
999    
1000    =item RETURN
1001    
1002    Returns a list of genome IDs corresponding to the named subset.
1003    
1004    =back
1005    
1006    =cut
1007    
1008    sub get_subsetR {
1009        # Get the parameters.
1010        my ($self, $subName) = @_;
1011        # Look for the specified row subset in the database. A row subset is identified using
1012        # the subsystem name and the subset name. The special subset "All" is actually
1013        # represented in the database, so we don't need to check for it.
1014        my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
1015                                            ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
1016        return @rows;
1017    }
1018    
1019  =head3 get_diagrams  =head3 get_diagrams
1020    
1021  C<< my @list = $sub->get_diagrams(); >>      my @list = $sub->get_diagrams();
1022    
1023  Return a list of the diagrams associated with this subsystem. Each diagram  Return a list of the diagrams associated with this subsystem. Each diagram
1024  is represented in the return list as a 4-tuple C<[diagram_id, diagram_name,  is represented in the return list as a 4-tuple C<[diagram_id, diagram_name,
# Line 588  Line 1054 
1054  sub get_diagrams {  sub get_diagrams {
1055      # Get the parameters.      # Get the parameters.
1056      my ($self) = @_;      my ($self) = @_;
     # Find the subsystem directory.  
     my $subDir = Subsystem::get_dir_from_name($self->{name});  
1057      # Get the diagram IDs.      # Get the diagram IDs.
1058      my @diagramIDs = Subsystem::GetDiagramIDs($subDir);      my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir});
1059        Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3);
1060      # Create the return variable.      # Create the return variable.
1061      my @retVal = ();      my @retVal = ();
1062      # Loop through the diagram IDs.      # Loop through the diagram IDs.
1063      for my $diagramID (@diagramIDs) {      for my $diagramID (@diagramIDs) {
1064          # Get the diagram name.          Trace("Processing diagram $diagramID.") if T(3);
1065          my $name = Subsystem::GetDiagramName($diagramID);          my ($name, $link, $imgLink) = $self->get_diagram($diagramID);
1066          # If a name was found, get the URLs.          Trace("Diagram $name URLs are \"$link\" and \"$imgLink\".") if T(3);
         if ($name) {  
             my ($link, $imgLink) = Subsystem::ComputeDiagramURLs($self->{name},  
                                                                  $diagramID);  
1067              push @retVal, [$diagramID, $name, $link, $imgLink];              push @retVal, [$diagramID, $name, $link, $imgLink];
1068          }          }
1069        # Return the result.
1070        return @retVal;
1071    }
1072    
1073    =head3 get_diagram
1074    
1075        my ($name, $pageURL, $imgURL) = $sub->get_diagram($id);
1076    
1077    Get the information (if any) for the specified diagram. The diagram corresponds
1078    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
1079    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
1080    where I<$dir> is the subsystem directory. The diagram's name is extracted from
1081    a tiny file containing the name, and then the links are computed using the
1082    subsystem name and the diagram ID. The parameters are as follows.
1083    
1084    =over 4
1085    
1086    =item id
1087    
1088    ID code for the desired diagram.
1089    
1090    =item RETURN
1091    
1092    Returns a three-element list. The first element is the diagram name, the second
1093    a URL for displaying information about the diagram, and the third a URL for
1094    displaying the diagram image.
1095    
1096    =back
1097    
1098    =cut
1099    
1100    sub get_diagram {
1101        my($self, $id) = @_;
1102        my $name = Subsystem::GetDiagramName($self->{dir}, $id);
1103        my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self, $self->{name}, $id, 1);
1104        return($name, $link, $img_link);
1105      }      }
1106    
1107    
1108    =head3 get_diagram_html_file
1109    
1110        my $fileName = $sub->get_diagram_html_file($id);
1111    
1112    Get the HTML file (if any) for the specified diagram. The diagram corresponds
1113    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
1114    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
1115    where I<$dir> is the subsystem directory. If an HTML file exists, it will be
1116    named C<diagram.html> in the diagram directory.  The parameters are as follows.
1117    
1118    =over 4
1119    
1120    =item id
1121    
1122    ID code for the desired diagram.
1123    
1124    =item RETURN
1125    
1126    Returns the name of an HTML diagram file, or C<undef> if no such file exists.
1127    
1128    =back
1129    
1130    =cut
1131    
1132    sub get_diagram_html_file {
1133        my ($self, $id) = @_;
1134        my $retVal;
1135        my $ddir = "$self->{dir}/diagrams/$id";
1136        Trace("Looking for diagram file at $ddir.") if T(3);
1137        if (-d $ddir) {
1138            my $html = "$ddir/diagram.html";
1139            if (-f $html) {
1140                $retVal = $html;
1141            }
1142        }
1143        return $retVal;
1144    }
1145    
1146    =head3 is_new_diagram
1147    
1148        my $flag = $sub->is_new_diagram($id);
1149    
1150    Return TRUE if the specified diagram is in the new format, else FALSE.
1151    
1152    =over 4
1153    
1154    =item id
1155    
1156    ID code (e.g. C<d03>) of the relevant diagram.
1157    
1158    =item RETURN
1159    
1160    Returns TRUE if the diagram is in the new format, else FALSE.
1161    
1162    =back
1163    
1164    =cut
1165    
1166    sub is_new_diagram {
1167      my ($self, $id) = @_;
1168    
1169      my $image_map = $self->get_diagram_html_file($id);
1170      if ($image_map) {
1171        Trace("Image map found for diagram $id at $image_map.") if T(3);
1172        Open(\*IN, "<$image_map");
1173        my $header = <IN>;
1174        close(IN);
1175    
1176        if ($header =~ /\<map name=\"GraffleExport\"\>/) {
1177          return 1;
1178        }
1179      }
1180    
1181      return undef;
1182    }
1183    
1184    =head3 get_role_from_abbr
1185    
1186        my $roleName = $sub->get_role_from_abbr($abbr);
1187    
1188    Return the role name corresponding to an abbreviation.
1189    
1190    =over 4
1191    
1192    =item abbr
1193    
1194    Abbreviation name of the relevant role.
1195    
1196    =item RETURN
1197    
1198    Returns the full name of the specified role.
1199    
1200    =back
1201    
1202    =cut
1203    
1204    sub get_role_from_abbr {
1205        # Get the parameters.
1206        my($self, $abbr) = @_;
1207        # Get the role name from the abbreviation hash.
1208        my $retVal = $self->{abbrHash}->{$abbr};
1209        # Check for a case incompatability.
1210        if (! defined $retVal) {
1211            $retVal = $self->{abbrHash}->{lcfirst $abbr};
1212        }
1213        # Return the result.
1214        return $retVal;
1215    }
1216    
1217    
1218    =head3 get_name
1219    
1220        my $name = $sub->get_name();
1221    
1222    Return the name of this subsystem.
1223    
1224    =cut
1225    
1226    sub get_name {
1227        # Get the parameters.
1228        my ($self) = @_;
1229        # Return the result.
1230        return $self->{name};
1231    }
1232    
1233    =head3 open_diagram_image
1234    
1235        my ($type, $fh) = $sub->open_diagram_image($id);
1236    
1237    Open a diagram's image file and return the type and file handle.
1238    
1239    =over 4
1240    
1241    =item id
1242    
1243    ID of the desired diagram
1244    
1245    =item RETURN
1246    
1247    Returns a 2-tuple containing the diagram's MIME type and an open filehandle
1248    for the diagram's data. If the diagram does not exist, the type will be
1249    returned as <undef>.
1250    
1251    =back
1252    
1253    =cut
1254    
1255    sub open_diagram_image {
1256        # Get the parameters.
1257        my ($self, $id) = @_;
1258        # Declare the return variables.
1259        my ($type, $fh);
1260        # Get the diagram directory.
1261        my $img_base = "$self->{dir}/diagrams/$id/diagram";
1262        # Get a list of file extensions and types.
1263        my %types = (png => "image/png",
1264                     gif => "image/gif",
1265                     jpg => "image/jpeg");
1266        # This is my new syntax for the for-each-while loop.
1267        # We loop until we run out of keys or come up with a type value.
1268        for my $ext (keys %types) { last if (defined $type);
1269            my $myType = $types{$ext};
1270            # Compute a file name for this diagram.
1271            my $file = "$img_base.$ext";
1272            # If it exists, try to open it.
1273            if (-f $file) {
1274                $fh = Open(undef, "<$file");
1275                $type = $myType;
1276            }
1277        }
1278        # Return the result.
1279        return ($type, $fh);
1280  }  }
1281    
1282    

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.20

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3