[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.17, Tue Sep 9 00:27:25 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 = Subsystem->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) = $subsystemObject->Values(['Subsystem(curator)', 'Subsystem(notes)',
122                                                                            'Subsystem(description)']);
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.          # Now we need to create the role ID directory and the reaction hash.
141          # 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.
142          # 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
143          # catalyzes.          # catalyzes.
144          my %roleHash = ();          my %roleHash = ();
145            my %abbrHash = ();
146          my %reactionHash = ();          my %reactionHash = ();
147          for ($idx = 0; $idx <= $#roles; $idx++) {          for ($idx = 0; $idx <= $#roles; $idx++) {
148              # Get the role ID and abbreviation for this column's role.              # Get the role ID and abbreviation for this column's role.
# Line 136  Line 150 
150              # Put them both in the role directory.              # Put them both in the role directory.
151              $roleHash{$roleID} = $idx;              $roleHash{$roleID} = $idx;
152              $roleHash{$abbr} = $idx;              $roleHash{$abbr} = $idx;
153                # Put the full name in the abbreviation directory.
154                $abbrHash{$abbr} = $roleID;
155              # Get this role's reactions.              # Get this role's reactions.
156              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',
157                                               [$roleID], 'Catalyzes(to-link)');                                               [$roleID], 'Catalyzes(to-link)');
# Line 144  Line 160 
160                  $reactionHash{$roleID} = \@reactions;                  $reactionHash{$roleID} = \@reactions;
161              }              }
162          }          }
163            # Find the subsystem directory.
164            my $subDir = Subsystem::get_dir_from_name($subName);
165            Trace("Subsystem directory is $subDir.") if T(3);
166          # Create the subsystem object.          # Create the subsystem object.
167          $retVal = {          $retVal = {
168                      # Name of the subsystem. This is needed for any further database                      # Name of the subsystem. This is needed for any further database
169                      # accesses required.                      # accesses required.
170                      name => $subName,                      name => $subName,
171                        # Directory root for diagram and image files.
172                        dir => $subDir,
173                      # Name of the subsystem's official curator.                      # Name of the subsystem's official curator.
174                      curator => $curator,                      curator => $curator,
175                      # General notes about the subsystem.                      # General notes about the subsystem.
# Line 165  Line 186 
186                      roles => \@roles,                      roles => \@roles,
187                      # Map of PEG IDs to cluster numbers.                      # Map of PEG IDs to cluster numbers.
188                      colorHash => {},                      colorHash => {},
189                        # Map of abbreviations to role names.
190                        abbrHash => \%abbrHash,
191                      # Map of role IDs to reactions.                      # Map of role IDs to reactions.
192                      reactionHash => \%reactionHash,                      reactionHash => \%reactionHash,
193                  };                  };
# Line 174  Line 197 
197      return $retVal;      return $retVal;
198  }  }
199    
200    =head3 get_row
201    
202        my $rowData = $sub->get_row($rowIndex);
203    
204    Return the specified row in the subsystem spreadsheet. The row consists
205    of a list of lists. Each position in the major list represents the role
206    for that position, and contains a list of the IDs for the features that
207    perform the role.
208    
209    =over 4
210    
211    =item rowIndex
212    
213    Index of the row to return. A row contains data for a single genome.
214    
215    =item RETURN
216    
217    Returns a reference to a list of lists. Each element in the list represents
218    a spreadsheet column (role) and contains a list of features that perform the
219    role.
220    
221    =back
222    
223    =cut
224    
225    sub get_row {
226        # Get the parameters.
227        my ($self, $rowIndex) = @_;
228        # Get the genome ID for the specified row's genome.
229        my $genomeID = $self->{genomes}->[$rowIndex]->[0];
230        # Read the row from the database. We won't get exactly what we want. Instead, we'll
231        # get a list of triplets, each consisting of a role name, a feature ID, and a cluster
232        # number. We need to convert this into a list of lists and stash the clustering information
233        # in the color hash.
234        my @rowData = $self->{sprout}->GetAll([qw(Subsystem HasSSCell IsGenomeOf IsRoleOf ContainsFeature)],
235                                              "Subsystem(id) = ? AND IsGenomeOf(from-link) = ?",
236                                              [$self->{name}, $genomeID],
237                                              [qw(IsRoleOf(from-link) ContainsFeature(to-link)
238                                                  ContainsFeature(cluster-number))]);
239        # Now we do the conversion. We must first create an array of empty lists, one per
240        # row index.
241        my @retVal = map { [] } @{$self->{roles}};
242        # Get the hash for converting role IDs to role indexes.
243        my $roleHash = $self->{roleHash};
244        # Now we stash all the feature IDs in the appropriate columns of the row list.
245        for my $rowDatum (@rowData) {
246            # Get the role ID, the peg ID, and the cluster number.
247            my ($role, $peg, $cluster) = @{$rowDatum};
248            # Put the peg in the role's peg list.
249            push @{$retVal[$roleHash->{$role}]}, $peg;
250            # Put the cluster number in the color hash.
251            $self->{colorHash}->{$peg} = $cluster;
252        }
253        # Return the result.
254        return \@retVal;
255    }
256    
257    =head3 get_roles_for_genome
258    
259        my @roles = $sub->get_roles_for_genome($genome_id);
260    
261    Return a list of the roles in this subsystem that have nonempty
262    spreadsheet cells for the given genome.
263    
264    =over 4
265    
266    =item genome_id
267    
268    ID of the relevant genome.
269    
270    =item RETURN
271    
272    Returns a list of role IDs.
273    
274    =back
275    
276    =cut
277    
278    sub get_roles_for_genome {
279        # Get the parameters.
280        my ($self, $genome_id) = @_;
281        # This next statement gets all of the nonempty cells for the genome's row and memorizes
282        # the roles by rolling them into a hash. The query connects four relationship tables on
283        # a single common key-- the spreadsheet cell ID. The IsGenomeOf table insures the cell is for the
284        # correct genome. The HasSSCell table insures that it belongs to the correct subsystem. The
285        # ContainsFeature table insures that it contains at least one feature. Finally, IsRoleOf tells
286        # us the cell's role. If a cell has more than one feature, the result list from the query will return
287        # one instance of the role for every distinct feature. The hash collapses the duplicates automatically.
288        my %retVal = map { $_ => 1 } $self->{sprout}->GetFlat([qw(ContainsFeature HasSSCell IsGenomeOf IsRoleOf)],
289                                                              "HasSSCell(from-link) = ? AND IsGenomeOf(from-link) = ?",
290                                                              [$self->{name}, $genome_id], 'IsRoleOf(from-link)');
291        # Return the result.
292        return keys %retVal;
293    }
294    
295    =head3 get_abbr_for_role
296    
297        my $abbr = $sub->get_abbr_for_role($name);
298    
299    Get this subsystem's abbreviation for the specified role.
300    
301    =over 4
302    
303    =item name
304    
305    Name of the relevant role.
306    
307    =item RETURN
308    
309    Returns the abbreviation for the role. Each subsystem has its own abbreviation
310    system; the abbreviations make it easier to display the subsystem spreadsheet.
311    
312    =back
313    
314    =cut
315    
316    sub get_abbr_for_role {
317        # Get the parameters.
318        my ($self, $name) = @_;
319        # Get the index for this role.
320        my $idx = $self->get_role_index($name);
321        # Return the abbreviation.
322        return $self->get_role_abbr($idx);
323    }
324    
325    =head3 get_subsetC
326    
327        my @columns = $sub->get_subsetC($subsetName);
328    
329    Return a list of the column numbers for the columns in the named role
330    subset.
331    
332    =over 4
333    
334    =item subsetName
335    
336    Name of the subset whose columns are desired.
337    
338    =item RETURN
339    
340    Returns a list of the indices for the columns in the named subset.
341    
342    =back
343    
344    =cut
345    
346    sub get_subsetC {
347        # Get the parameters.
348        my ($self, $subsetName) = @_;
349        # Get the roles in the subset.
350        my @roles = $self->get_subsetC_roles($subsetName);
351        # Convert them to indices.
352        my $roleHash = $self->{roleHash};
353        my @retVal = map { $roleHash->{$_} } @roles;
354        # Return the result.
355        return @retVal;
356    }
357    
358  =head3 get_genomes  =head3 get_genomes
359    
360  C<< my @genomeList = $sub->get_genomes(); >>      my @genomeList = $sub->get_genomes();
361    
362  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
363  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 377 
377    
378  =head3 get_variant_code  =head3 get_variant_code
379    
380  C<< my $code = $sub->get_variant_code($gidx); >>      my $code = $sub->get_variant_code($gidx);
381    
382  Return the variant code for the specified genome. Each subsystem has multiple  Return the variant code for the specified genome. Each subsystem has multiple
383  variants which involve slightly different chemical reactions, and each variant  variants which involve slightly different chemical reactions, and each variant
# Line 222  Line 403 
403      my ($self, $gidx) = @_;      my ($self, $gidx) = @_;
404      # 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
405      # element of the tuple from the "genomes" member.      # element of the tuple from the "genomes" member.
406      my $retVal = $self->{genomes}->{$gidx}->[1];      my $retVal = $self->{genomes}->[$gidx]->[1];
407      return $retVal;      return $retVal;
408  }  }
409    
410  =head3 get_curator  =head3 get_curator
411    
412  C<< my $userName = $sub->get_curator(); >>      my $userName = $sub->get_curator();
413    
414  Return the name of this subsystem's official curator.  Return the name of this subsystem's official curator.
415    
# Line 243  Line 424 
424    
425  =head3 get_notes  =head3 get_notes
426    
427  C<< my $text = $sub->get_notes(); >>      my $text = $sub->get_notes();
428    
429  Return the descriptive notes for this subsystem.  Return the descriptive notes for this subsystem.
430    
# Line 256  Line 437 
437      return $self->{notes};      return $self->{notes};
438  }  }
439    
440    =head3 get_description
441    
442        my $text = $sub->get_description();
443    
444    Return the description for this subsystem.
445    
446    =cut
447    
448    sub get_description
449    {
450        my($self) = @_;
451        return $self->{description};
452    }
453    
454  =head3 get_roles  =head3 get_roles
455    
456  C<< my @roles = $sub->get_roles(); >>      my @roles = $sub->get_roles();
457    
458  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
459  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 472 
472    
473  =head3 get_reactions  =head3 get_reactions
474    
475  C<< my $reactHash = $sub->get_reactions(); >>      my $reactHash = $sub->get_reactions();
476    
477  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
478  catalyzed by the role.  catalyzed by the role.
# Line 293  Line 488 
488    
489  =head3 get_subset_namesC  =head3 get_subset_namesC
490    
491  C<< my @subsetNames = $sub->get_subset_namesC(); >>      my @subsetNames = $sub->get_subset_namesC();
492    
493  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
494  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 510 
510      return @retVal;      return @retVal;
511  }  }
512    
513    =head3 get_subset_names
514    
515        my @subsetNames = $sub->get_subset_names();
516    
517    Return the names of the column subsets.
518    
519    =cut
520    
521    sub get_subset_names{
522        # Get the parameters.
523        my ($self) = @_;
524        # Return the result.
525        return $self->get_subset_namesC();
526    }
527    
528  =head3 get_role_abbr  =head3 get_role_abbr
529    
530  C<< my $abbr = $sub->get_role_abbr($ridx); >>      my $abbr = $sub->get_role_abbr($ridx);
531    
532  Return the abbreviation for the role in the specified column. The abbreviation  Return the abbreviation for the role in the specified column. The abbreviation
533  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 556 
556      return $retVal;      return $retVal;
557  }  }
558    
559    
560    =head3 get_hope_reactions_for_genome
561    
562        my %ss_reactions = $subsys->get_hope_reactions_for_genome($genome);
563    
564    This method returns a hash that maps reactions to the pegs that catalyze
565    them for the specified genome. For each role in the subsystem, the pegs
566    are computed, and these are attached to the reactions for the role.
567    
568    =over 4
569    
570    =item genome
571    
572    ID of the genome whose reactions are to be put into the hash.
573    
574    =item RETURN
575    
576    Returns a hash mapping reactions in the subsystem to pegs in the
577    specified genome, or C<undef> if the genome is not found in the
578    subsystem.
579    
580    =back
581    
582    =cut
583    
584    sub get_hope_reactions_for_genome {
585        my($self, $genome) = @_;
586        my $index = $self->{genome_index}->{$genome};
587        if (defined $index) {
588            my @roles = $self->get_roles;
589            my %hope_reactions = $self->get_hope_reactions;
590    
591            my %ss_reactions;
592    
593            foreach my $role (@roles)
594            {
595                my @peg_list = $self->get_pegs_from_cell($genome,$role);
596    
597                if (defined $hope_reactions{$role} && scalar @peg_list > 0)
598    
599                {
600                    foreach my $reaction (@{$hope_reactions{$role}})
601                    {
602                        push @{$ss_reactions{$reaction}}, @peg_list;
603                    }
604                }
605            }
606    
607            return %ss_reactions;
608        }
609        else {
610            return undef;
611        }
612    }
613    
614    
615    =head3 get_hope_additional_reactions
616    
617        my %ss_reactions = $subsys->get_hope_additional_reactions($scenario_name);
618    
619    Return a list of the additional reactions for the specified scenario.
620    
621    =over 4
622    
623    =item scenario_name
624    
625    Name of the scenario whose additional reactions are desired.
626    
627    =item RETURN
628    
629    Returns a list of the additional reactions attached to the named scenario.
630    
631    =back
632    
633    =cut
634    
635    sub get_hope_additional_reactions
636    {
637        my($self,$scenario_name) = @_;
638        Trace("Hope additional reactions not available in NMPDR.") if T(0);  ##HACK
639        my @retVal;
640        return @retVal;
641    }
642    
643    
644    =head3 get_hope_reactions
645    
646        my %reactionHash = $subsys->get_hope_reactions();
647    
648    Return a hash mapping the roles of this subsystem to the EC numbers for
649    the reactions used in scenarios (if any). It may return an empty hash
650    if the Hope reactions are not yet known.
651    
652    =cut
653    
654    sub get_hope_reactions {
655        # Get the parameters.
656        my ($self) = @_;
657        # Try to get the hope reactions from the object.
658        my $retVal = $self->{hopeReactions};
659        if (! defined($retVal)) {
660            # They do not exist, so we must create them.
661            $retVal = FIGRules::GetHopeReactions($self, $self->{dir}); ##HACK
662            # Insure we have it if we need it again.
663            $self->{hopeReactions} = $retVal;
664        }
665        # Return the result.
666        return %{$retVal};
667    }
668    
669  =head3 get_role_index  =head3 get_role_index
670    
671  C<< my $idx = $sub->get_role_index($role); >>      my $idx = $sub->get_role_index($role);
672    
673  Return the column index for the role with the specified ID.  Return the column index for the role with the specified ID.
674    
# Line 376  Line 696 
696    
697  =head3 get_subsetC_roles  =head3 get_subsetC_roles
698    
699  C<< my @roles = $sub->get_subsetC_roles($subname); >>      my @roles = $sub->get_subsetC_roles($subname);
700    
701  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.
702    
# Line 414  Line 734 
734    
735  =head3 get_genome_index  =head3 get_genome_index
736    
737  C<< my $idx = $sub->get_genome_index($genome); >>      my $idx = $sub->get_genome_index($genome);
738    
739  Return the row index for the genome with the specified ID.  Return the row index for the genome with the specified ID.
740    
# Line 443  Line 763 
763    
764  =head3 get_cluster_number  =head3 get_cluster_number
765    
766  C<< my $number = $sub->get_cluster_number($pegID); >>      my $number = $sub->get_cluster_number($pegID);
767    
768  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
769  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 803 
803    
804  =head3 get_pegs_from_cell  =head3 get_pegs_from_cell
805    
806  C<< my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr); >>      my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr);
807    
808  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.
809    
# Line 533  Line 853 
853          }          }
854      }      }
855      # Construct the spreadsheet cell ID from the information we have.      # Construct the spreadsheet cell ID from the information we have.
856      my $cellID = $self->{name} . ":$genomeID:$colIdx";      my $cellID = $sprout->DigestKey($self->{name} . ":$genomeID:$colIdx");
857      # 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.
858      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',
859                                    [$cellID], ['ContainsFeature(to-link)',                                    [$cellID], ['ContainsFeature(to-link)',
# Line 550  Line 870 
870      return @retVal;      return @retVal;
871  }  }
872    
873    =head3 get_subsetR
874    
875        my @genomes = $sub->get_subsetR($subName);
876    
877    Return the genomes in the row subset indicated by the specified subset name.
878    
879    =over 4
880    
881    =item subName
882    
883    Name of the desired row subset, or C<All> to get all of the rows.
884    
885    =item RETURN
886    
887    Returns a list of genome IDs corresponding to the named subset.
888    
889    =back
890    
891    =cut
892    
893    sub get_subsetR {
894        # Get the parameters.
895        my ($self, $subName) = @_;
896        # Look for the specified row subset in the database. A row subset is identified using
897        # the subsystem name and the subset name. The special subset "All" is actually
898        # represented in the database, so we don't need to check for it.
899        my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
900                                            ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
901        return @rows;
902    }
903    
904  =head3 get_diagrams  =head3 get_diagrams
905    
906  C<< my @list = $sub->get_diagrams(); >>      my @list = $sub->get_diagrams();
907    
908  Return a list of the diagrams associated with this subsystem. Each diagram  Return a list of the diagrams associated with this subsystem. Each diagram
909  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 939 
939  sub get_diagrams {  sub get_diagrams {
940      # Get the parameters.      # Get the parameters.
941      my ($self) = @_;      my ($self) = @_;
     # Find the subsystem directory.  
     my $subDir = Subsystem::get_dir_from_name($self->{name});  
942      # Get the diagram IDs.      # Get the diagram IDs.
943      my @diagramIDs = Subsystem::GetDiagramIDs($subDir);      my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir});
944        Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3);
945      # Create the return variable.      # Create the return variable.
946      my @retVal = ();      my @retVal = ();
947      # Loop through the diagram IDs.      # Loop through the diagram IDs.
948      for my $diagramID (@diagramIDs) {      for my $diagramID (@diagramIDs) {
949          # Get the diagram name.          Trace("Processing diagram $diagramID.") if T(3);
950          my $name = Subsystem::GetDiagramName($diagramID);          my ($name, $link, $imgLink) = $self->get_diagram($diagramID);
951          # 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);  
952              push @retVal, [$diagramID, $name, $link, $imgLink];              push @retVal, [$diagramID, $name, $link, $imgLink];
953          }          }
954        # Return the result.
955        return @retVal;
956    }
957    
958    =head3 get_diagram
959    
960        my ($name, $pageURL, $imgURL) = $sub->get_diagram($id);
961    
962    Get the information (if any) for the specified diagram. The diagram corresponds
963    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
964    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
965    where I<$dir> is the subsystem directory. The diagram's name is extracted from
966    a tiny file containing the name, and then the links are computed using the
967    subsystem name and the diagram ID. The parameters are as follows.
968    
969    =over 4
970    
971    =item id
972    
973    ID code for the desired diagram.
974    
975    =item RETURN
976    
977    Returns a three-element list. The first element is the diagram name, the second
978    a URL for displaying information about the diagram, and the third a URL for
979    displaying the diagram image.
980    
981    =back
982    
983    =cut
984    
985    sub get_diagram {
986        my($self, $id) = @_;
987        my $name = Subsystem::GetDiagramName($self->{dir}, $id);
988        my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self, $self->{name}, $id, 1);
989        return($name, $link, $img_link);
990    }
991    
992    
993    =head3 get_diagram_html_file
994    
995        my $fileName = $sub->get_diagram_html_file($id);
996    
997    Get the HTML file (if any) for the specified diagram. The diagram corresponds
998    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
999    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
1000    where I<$dir> is the subsystem directory. If an HTML file exists, it will be
1001    named C<diagram.html> in the diagram directory.  The parameters are as follows.
1002    
1003    =over 4
1004    
1005    =item id
1006    
1007    ID code for the desired diagram.
1008    
1009    =item RETURN
1010    
1011    Returns the name of an HTML diagram file, or C<undef> if no such file exists.
1012    
1013    =back
1014    
1015    =cut
1016    
1017    sub get_diagram_html_file {
1018        my ($self, $id) = @_;
1019        my $retVal;
1020        my $ddir = "$self->{dir}/diagrams/$id";
1021        if (-d $ddir) {
1022            my $html = "$ddir/diagram.html";
1023            if (-f $html) {
1024                $retVal = $html;
1025            }
1026        }
1027        return $retVal;
1028    }
1029    
1030    =head3 is_new_diagram
1031    
1032        my $flag = $sub->is_new_diagram($id);
1033    
1034    Return TRUE if the specified diagram is in the new format, else FALSE.
1035    
1036    =over 4
1037    
1038    =item id
1039    
1040    ID code (e.g. C<d03>) of the relevant diagram.
1041    
1042    =item RETURN
1043    
1044    Returns TRUE if the diagram is in the new format, else FALSE.
1045    
1046    =back
1047    
1048    =cut
1049    
1050    sub is_new_diagram {
1051      my ($self, $id) = @_;
1052    
1053      my $image_map = $self->get_diagram_html_file($id);
1054      if ($image_map) {
1055        Trace("Image map found for diagram $id at $image_map.") if T(3);
1056        Open(\*IN, "<$image_map");
1057        my $header = <IN>;
1058        close(IN);
1059    
1060        if ($header =~ /\<map name=\"GraffleExport\"\>/) {
1061          return 1;
1062        }
1063      }
1064    
1065      return undef;
1066    }
1067    
1068    =head3 get_role_from_abbr
1069    
1070        my $roleName = $sub->get_role_from_abbr($abbr);
1071    
1072    Return the role name corresponding to an abbreviation.
1073    
1074    =over 4
1075    
1076    =item abbr
1077    
1078    Abbreviation name of the relevant role.
1079    
1080    =item RETURN
1081    
1082    Returns the full name of the specified role.
1083    
1084    =back
1085    
1086    =cut
1087    
1088    sub get_role_from_abbr {
1089        # Get the parameters.
1090        my($self, $abbr) = @_;
1091        # Get the role name from the abbreviation hash.
1092        my $retVal = $self->{abbrHash}->{$abbr};
1093        # Check for a case incompatability.
1094        if (! defined $retVal) {
1095            $retVal = $self->{abbrHash}->{lcfirst $abbr};
1096        }
1097        # Return the result.
1098        return $retVal;
1099    }
1100    
1101    
1102    =head3 get_name
1103    
1104        my $name = $sub->get_name();
1105    
1106    Return the name of this subsystem.
1107    
1108    =cut
1109    
1110    sub get_name {
1111        # Get the parameters.
1112        my ($self) = @_;
1113        # Return the result.
1114        return $self->{name};
1115    }
1116    
1117    =head3 open_diagram_image
1118    
1119        my ($type, $fh) = $sub->open_diagram_image($id);
1120    
1121    Open a diagram's image file and return the type and file handle.
1122    
1123    =over 4
1124    
1125    =item id
1126    
1127    ID of the desired diagram
1128    
1129    =item RETURN
1130    
1131    Returns a 2-tuple containing the diagram's MIME type and an open filehandle
1132    for the diagram's data. If the diagram does not exist, the type will be
1133    returned as <undef>.
1134    
1135    =back
1136    
1137    =cut
1138    
1139    sub open_diagram_image {
1140        # Get the parameters.
1141        my ($self, $id) = @_;
1142        # Declare the return variables.
1143        my ($type, $fh);
1144        # Get the diagram directory.
1145        my $img_base = "$self->{dir}/diagrams/$id/diagram";
1146        # Get a list of file extensions and types.
1147        my %types = (png => "image/png",
1148                     gif => "image/gif",
1149                     jpg => "image/jpeg");
1150        # This is my new syntax for the for-each-while loop.
1151        # We loop until we run out of keys or come up with a type value.
1152        for my $ext (keys %types) { last if (defined $type);
1153            my $myType = $types{$ext};
1154            # Compute a file name for this diagram.
1155            my $file = "$img_base.$ext";
1156            # If it exists, try to open it.
1157            if (-f $file) {
1158                $fh = Open(undef, "<$file");
1159                $type = $myType;
1160      }      }
1161  }  }
1162        # Return the result.
1163        return ($type, $fh);
1164    }
1165    
1166    
1167  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3