[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.12, Thu Dec 6 14:50:08 2007 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 121  Line 130 
130          # 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
131          # 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
132          # 2-tuples will be ordered by the spreadsheet column number.          # 2-tuples will be ordered by the spreadsheet column number.
133          my @roles = $sprout->GetAll(['OccursInSubsystem', 'Role'],          my @roles = $sprout->GetAll(['OccursInSubsystem'],
134                                      'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',                                      'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',
135                                      [$subName], ['OccursInSubsystem(from-link)', 'Role(abbr)']);                                      [$subName], ['OccursInSubsystem(from-link)', 'OccursInSubsystem(abbr)']);
136          # 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.
137          # 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.
138          # 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
139          # catalyzes.          # catalyzes.
140          my %roleHash = ();          my %roleHash = ();
141            my %abbrHash = ();
142          my %reactionHash = ();          my %reactionHash = ();
143          for ($idx = 0; $idx <= $#roles; $idx++) {          for ($idx = 0; $idx <= $#roles; $idx++) {
144              # 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 146 
146              # Put them both in the role directory.              # Put them both in the role directory.
147              $roleHash{$roleID} = $idx;              $roleHash{$roleID} = $idx;
148              $roleHash{$abbr} = $idx;              $roleHash{$abbr} = $idx;
149                # Put the full name in the abbreviation directory.
150                $abbrHash{$abbr} = $roleID;
151              # Get this role's reactions.              # Get this role's reactions.
152              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',
153                                               [$roleID], 'Catalyzes(to-link)');                                               [$roleID], 'Catalyzes(to-link)');
# Line 144  Line 156 
156                  $reactionHash{$roleID} = \@reactions;                  $reactionHash{$roleID} = \@reactions;
157              }              }
158          }          }
159            # Find the subsystem directory.
160            my $subDir = Subsystem::get_dir_from_name($subName);
161            Trace("Subsystem directory is $subDir.") if T(3);
162          # Create the subsystem object.          # Create the subsystem object.
163          $retVal = {          $retVal = {
164                      # Name of the subsystem. This is needed for any further database                      # Name of the subsystem. This is needed for any further database
165                      # accesses required.                      # accesses required.
166                      name => $subName,                      name => $subName,
167                        # Directory root for diagram and image files.
168                        dir => $subDir,
169                      # Name of the subsystem's official curator.                      # Name of the subsystem's official curator.
170                      curator => $curator,                      curator => $curator,
171                      # General notes about the subsystem.                      # General notes about the subsystem.
# Line 165  Line 182 
182                      roles => \@roles,                      roles => \@roles,
183                      # Map of PEG IDs to cluster numbers.                      # Map of PEG IDs to cluster numbers.
184                      colorHash => {},                      colorHash => {},
185                        # Map of abbreviations to role names.
186                        abbrHash => \%abbrHash,
187                      # Map of role IDs to reactions.                      # Map of role IDs to reactions.
188                      reactionHash => \%reactionHash,                      reactionHash => \%reactionHash,
189                  };                  };
# Line 174  Line 193 
193      return $retVal;      return $retVal;
194  }  }
195    
196    =head3 get_row
197    
198        my $rowData = $sub->get_row($rowIndex);
199    
200    Return the specified row in the subsystem spreadsheet. The row consists
201    of a list of lists. Each position in the major list represents the role
202    for that position, and contains a list of the IDs for the features that
203    perform the role.
204    
205    =over 4
206    
207    =item rowIndex
208    
209    Index of the row to return. A row contains data for a single genome.
210    
211    =item RETURN
212    
213    Returns a reference to a list of lists. Each element in the list represents
214    a spreadsheet column (role) and contains a list of features that perform the
215    role.
216    
217    =back
218    
219    =cut
220    
221    sub get_row {
222        # Get the parameters.
223        my ($self, $rowIndex) = @_;
224        # Get the genome ID for the specified row's genome.
225        my $genomeID = $self->{genomes}->[$rowIndex]->[0];
226        # Read the row from the database. We won't get exactly what we want. Instead, we'll
227        # get a list of triplets, each consisting of a role name, a feature ID, and a cluster
228        # number. We need to convert this into a list of lists and stash the clustering information
229        # in the color hash.
230        my @rowData = $self->{sprout}->GetAll([qw(Subsystem HasSSCell IsGenomeOf IsRoleOf ContainsFeature)],
231                                              "Subsystem(id) = ? AND IsGenomeOf(from-link) = ?",
232                                              [$self->{name}, $genomeID],
233                                              [qw(IsRoleOf(from-link) ContainsFeature(to-link)
234                                                  ContainsFeature(cluster-number))]);
235        # Now we do the conversion. We must first create an array of empty lists, one per
236        # row index.
237        my @retVal = map { [] } @{$self->{roles}};
238        # Get the hash for converting role IDs to role indexes.
239        my $roleHash = $self->{roleHash};
240        # Now we stash all the feature IDs in the appropriate columns of the row list.
241        for my $rowDatum (@rowData) {
242            # Get the role ID, the peg ID, and the cluster number.
243            my ($role, $peg, $cluster) = @{$rowDatum};
244            # Put the peg in the role's peg list.
245            push @{$retVal[$roleHash->{$role}]}, $peg;
246            # Put the cluster number in the color hash.
247            $self->{colorHash}->{$peg} = $cluster;
248        }
249        # Return the result.
250        return \@retVal;
251    }
252    
253    =head3 get_abbr_for_role
254    
255        my $abbr = $sub->get_abbr_for_role($name);
256    
257    Get this subsystem's abbreviation for the specified role.
258    
259    =over 4
260    
261    =item name
262    
263    Name of the relevant role.
264    
265    =item RETURN
266    
267    Returns the abbreviation for the role. Each subsystem has its own abbreviation
268    system; the abbreviations make it easier to display the subsystem spreadsheet.
269    
270    =back
271    
272    =cut
273    
274    sub get_abbr_for_role{
275        # Get the parameters.
276        my ($self, $name) = @_;
277        # Get the index for this role.
278        my $idx = $self->get_role_index($name);
279        # Return the abbreviation.
280        return $self->get_role_abbr($idx);
281    }
282    
283    =head3 get_subsetC
284    
285        my @columns = $sub->get_subsetC($subsetName);
286    
287    Return a list of the column numbers for the columns in the named role
288    subset.
289    
290    =over 4
291    
292    =item subsetName
293    
294    Name of the subset whose columns are desired.
295    
296    =item RETURN
297    
298    Returns a list of the indices for the columns in the named subset.
299    
300    =back
301    
302    =cut
303    
304    sub get_subsetC {
305        # Get the parameters.
306        my ($self, $subsetName) = @_;
307        # Get the roles in the subset.
308        my @roles = $self->get_subsetC_roles($subsetName);
309        # Convert them to indices.
310        my $roleHash = $self->{roleHash};
311        my @retVal = map { $roleHash->{$_} } @roles;
312        # Return the result.
313        return @retVal;
314    }
315    
316  =head3 get_genomes  =head3 get_genomes
317    
318  C<< my @genomeList = $sub->get_genomes(); >>      my @genomeList = $sub->get_genomes();
319    
320  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
321  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 335 
335    
336  =head3 get_variant_code  =head3 get_variant_code
337    
338  C<< my $code = $sub->get_variant_code($gidx); >>      my $code = $sub->get_variant_code($gidx);
339    
340  Return the variant code for the specified genome. Each subsystem has multiple  Return the variant code for the specified genome. Each subsystem has multiple
341  variants which involve slightly different chemical reactions, and each variant  variants which involve slightly different chemical reactions, and each variant
# Line 222  Line 361 
361      my ($self, $gidx) = @_;      my ($self, $gidx) = @_;
362      # 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
363      # element of the tuple from the "genomes" member.      # element of the tuple from the "genomes" member.
364      my $retVal = $self->{genomes}->{$gidx}->[1];      my $retVal = $self->{genomes}->[$gidx]->[1];
365      return $retVal;      return $retVal;
366  }  }
367    
368  =head3 get_curator  =head3 get_curator
369    
370  C<< my $userName = $sub->get_curator(); >>      my $userName = $sub->get_curator();
371    
372  Return the name of this subsystem's official curator.  Return the name of this subsystem's official curator.
373    
# Line 243  Line 382 
382    
383  =head3 get_notes  =head3 get_notes
384    
385  C<< my $text = $sub->get_notes(); >>      my $text = $sub->get_notes();
386    
387  Return the descriptive notes for this subsystem.  Return the descriptive notes for this subsystem.
388    
# Line 258  Line 397 
397    
398  =head3 get_roles  =head3 get_roles
399    
400  C<< my @roles = $sub->get_roles(); >>      my @roles = $sub->get_roles();
401    
402  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
403  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 416 
416    
417  =head3 get_reactions  =head3 get_reactions
418    
419  C<< my $reactHash = $sub->get_reactions(); >>      my $reactHash = $sub->get_reactions();
420    
421  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
422  catalyzed by the role.  catalyzed by the role.
# Line 293  Line 432 
432    
433  =head3 get_subset_namesC  =head3 get_subset_namesC
434    
435  C<< my @subsetNames = $sub->get_subset_namesC(); >>      my @subsetNames = $sub->get_subset_namesC();
436    
437  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
438  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 454 
454      return @retVal;      return @retVal;
455  }  }
456    
457    =head3 get_subset_names
458    
459        my @subsetNames = $sub->get_subset_names();
460    
461    Return the names of the column subsets.
462    
463    =cut
464    
465    sub get_subset_names{
466        # Get the parameters.
467        my ($self) = @_;
468        # Return the result.
469        return $self->get_subset_namesC();
470    }
471    
472  =head3 get_role_abbr  =head3 get_role_abbr
473    
474  C<< my $abbr = $sub->get_role_abbr($ridx); >>      my $abbr = $sub->get_role_abbr($ridx);
475    
476  Return the abbreviation for the role in the specified column. The abbreviation  Return the abbreviation for the role in the specified column. The abbreviation
477  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 500 
500      return $retVal;      return $retVal;
501  }  }
502    
503    =head3 get_hope_reactions
504    
505        my $reactionHash = $subsys->get_hope_reactions();
506    
507    Return a hash mapping the roles of this subsystem to the EC numbers for
508    the reactions used in scenarios (if any). It may return an empty hash
509    if the Hope reactions are not yet known.
510    
511    =cut
512    
513    sub get_hope_reactions {
514        # Get the parameters.
515        my ($self) = @_;
516        # Try to get the hope reactions from the object.
517        my $retVal = $self->{hopeReactions};
518        if (! defined($retVal)) {
519            # They do not exist, so we must create them.
520            $retVal = FIGRules::GetHopeReactions($self, $self->{dir});
521            # Insure we have it if we need it again.
522            $self->{hopeReactions} = $retVal;
523        }
524        # Return the result.
525        return $retVal;
526    }
527    
528  =head3 get_role_index  =head3 get_role_index
529    
530  C<< my $idx = $sub->get_role_index($role); >>      my $idx = $sub->get_role_index($role);
531    
532  Return the column index for the role with the specified ID.  Return the column index for the role with the specified ID.
533    
# Line 376  Line 555 
555    
556  =head3 get_subsetC_roles  =head3 get_subsetC_roles
557    
558  C<< my @roles = $sub->get_subsetC_roles($subname); >>      my @roles = $sub->get_subsetC_roles($subname);
559    
560  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.
561    
# Line 414  Line 593 
593    
594  =head3 get_genome_index  =head3 get_genome_index
595    
596  C<< my $idx = $sub->get_genome_index($genome); >>      my $idx = $sub->get_genome_index($genome);
597    
598  Return the row index for the genome with the specified ID.  Return the row index for the genome with the specified ID.
599    
# Line 443  Line 622 
622    
623  =head3 get_cluster_number  =head3 get_cluster_number
624    
625  C<< my $number = $sub->get_cluster_number($pegID); >>      my $number = $sub->get_cluster_number($pegID);
626    
627  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
628  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 662 
662    
663  =head3 get_pegs_from_cell  =head3 get_pegs_from_cell
664    
665  C<< my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr); >>      my @pegs = $sub->get_pegs_from_cell($rowstr, $colstr);
666    
667  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.
668    
# Line 533  Line 712 
712          }          }
713      }      }
714      # Construct the spreadsheet cell ID from the information we have.      # Construct the spreadsheet cell ID from the information we have.
715      my $cellID = $self->{name} . ":$genomeID:$colIdx";      my $cellID = $sprout->DigestKey($self->{name} . ":$genomeID:$colIdx");
716      # 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.
717      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',
718                                    [$cellID], ['ContainsFeature(to-link)',                                    [$cellID], ['ContainsFeature(to-link)',
# Line 550  Line 729 
729      return @retVal;      return @retVal;
730  }  }
731    
732    =head3 get_subsetR
733    
734        my @genomes = $sub->get_subsetR($subName);
735    
736    Return the genomes in the row subset indicated by the specified subset name.
737    
738    =over 4
739    
740    =item subName
741    
742    Name of the desired row subset, or C<All> to get all of the rows.
743    
744    =item RETURN
745    
746    Returns a list of genome IDs corresponding to the named subset.
747    
748    =back
749    
750    =cut
751    
752    sub get_subsetR {
753        # Get the parameters.
754        my ($self, $subName) = @_;
755        # Look for the specified row subset in the database. A row subset is identified using
756        # the subsystem name and the subset name. The special subset "All" is actually
757        # represented in the database, so we don't need to check for it.
758        my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
759                                            ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
760        return @rows;
761    }
762    
763  =head3 get_diagrams  =head3 get_diagrams
764    
765  C<< my @list = $sub->get_diagrams(); >>      my @list = $sub->get_diagrams();
766    
767  Return a list of the diagrams associated with this subsystem. Each diagram  Return a list of the diagrams associated with this subsystem. Each diagram
768  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 798 
798  sub get_diagrams {  sub get_diagrams {
799      # Get the parameters.      # Get the parameters.
800      my ($self) = @_;      my ($self) = @_;
     # Find the subsystem directory.  
     my $subDir = Subsystem::get_dir_from_name($self->{name});  
801      # Get the diagram IDs.      # Get the diagram IDs.
802      my @diagramIDs = Subsystem::GetDiagramIDs($subDir);      my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir});
803        Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3);
804      # Create the return variable.      # Create the return variable.
805      my @retVal = ();      my @retVal = ();
806      # Loop through the diagram IDs.      # Loop through the diagram IDs.
807      for my $diagramID (@diagramIDs) {      for my $diagramID (@diagramIDs) {
808          # Get the diagram name.          Trace("Processing diagram $diagramID.") if T(3);
809          my $name = Subsystem::GetDiagramName($diagramID);          my ($name, $link, $imgLink) = $self->get_diagram($diagramID);
810          # 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);  
811              push @retVal, [$diagramID, $name, $link, $imgLink];              push @retVal, [$diagramID, $name, $link, $imgLink];
812          }          }
813        # Return the result.
814        return @retVal;
815    }
816    
817    =head3 get_diagram
818    
819        my ($name, $pageURL, $imgURL) = $sub->get_diagram($id);
820    
821    Get the information (if any) for the specified diagram. The diagram corresponds
822    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
823    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
824    where I<$dir> is the subsystem directory. The diagram's name is extracted from
825    a tiny file containing the name, and then the links are computed using the
826    subsystem name and the diagram ID. The parameters are as follows.
827    
828    =over 4
829    
830    =item id
831    
832    ID code for the desired diagram.
833    
834    =item RETURN
835    
836    Returns a three-element list. The first element is the diagram name, the second
837    a URL for displaying information about the diagram, and the third a URL for
838    displaying the diagram image.
839    
840    =back
841    
842    =cut
843    
844    sub get_diagram {
845        my($self, $id) = @_;
846        my $name = Subsystem::GetDiagramName($self->{dir}, $id);
847        my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self, $self->{name}, $id, 1);
848        return($name, $link, $img_link);
849    }
850    
851    
852    =head3 get_diagram_html_file
853    
854        my $fileName = $sub->get_diagram_html_file($id);
855    
856    Get the HTML file (if any) for the specified diagram. The diagram corresponds
857    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
858    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
859    where I<$dir> is the subsystem directory. If an HTML file exists, it will be
860    named C<diagram.html> in the diagram directory.  The parameters are as follows.
861    
862    =over 4
863    
864    =item id
865    
866    ID code for the desired diagram.
867    
868    =item RETURN
869    
870    Returns the name of an HTML diagram file, or C<undef> if no such file exists.
871    
872    =back
873    
874    =cut
875    
876    sub get_diagram_html_file {
877        my ($self, $id) = @_;
878        my $retVal;
879        my $ddir = "$self->{dir}/diagrams/$id";
880        if (-d $ddir) {
881            my $html = "$ddir/diagram.html";
882            if (-f $html) {
883                $retVal = $html;
884            }
885        }
886        return $retVal;
887    }
888    
889    =head3 is_new_diagram
890    
891        my $flag = $sub->is_new_diagram($id);
892    
893    Return TRUE if the specified diagram is in the new format, else FALSE.
894    
895    =over 4
896    
897    =item id
898    
899    ID code (e.g. C<d03>) of the relevant diagram.
900    
901    =item RETURN
902    
903    Returns TRUE if the diagram is in the new format, else FALSE.
904    
905    =back
906    
907    =cut
908    
909    sub is_new_diagram {
910      my ($self, $id) = @_;
911    
912      my $image_map = $self->get_diagram_html_file($id);
913      if ($image_map) {
914        Trace("Image map found for diagram $id at $image_map.") if T(3);
915        open(IN, "$image_map") or Confess("Unable to open file $image_map.");
916        my $header = <IN>;
917        close(IN);
918    
919        if ($header =~ /\<map name=\"GraffleExport\"\>/) {
920          return 1;
921        }
922      }
923    
924      return undef;
925    }
926    
927    =head3 get_role_from_abbr
928    
929        my $roleName = $sub->get_role_from_abbr($abbr);
930    
931    Return the role name corresponding to an abbreviation.
932    
933    =over 4
934    
935    =item abbr
936    
937    Abbreviation name of the relevant role.
938    
939    =item RETURN
940    
941    Returns the full name of the specified role.
942    
943    =back
944    
945    =cut
946    
947    sub get_role_from_abbr {
948        # Get the parameters.
949        my($self, $abbr) = @_;
950        # Get the role name from the abbreviation hash.
951        my $retVal = $self->{abbrHash}->{$abbr};
952        # Check for a case incompatability.
953        if (! defined $retVal) {
954            $retVal = $self->{abbrHash}->{lcfirst $abbr};
955        }
956        # Return the result.
957        return $retVal;
958    }
959    
960    
961    =head3 get_name
962    
963        my $name = $sub->get_name();
964    
965    Return the name of this subsystem.
966    
967    =cut
968    
969    sub get_name {
970        # Get the parameters.
971        my ($self) = @_;
972        # Return the result.
973        return $self->{name};
974    }
975    
976    =head3 open_diagram_image
977    
978        my ($type, $fh) = $sub->open_diagram_image($id);
979    
980    Open a diagram's image file and return the type and file handle.
981    
982    =over 4
983    
984    =item id
985    
986    ID of the desired diagram
987    
988    =item RETURN
989    
990    Returns a 2-tuple containing the diagram's MIME type and an open filehandle
991    for the diagram's data. If the diagram does not exist, the type will be
992    returned as <undef>.
993    
994    =back
995    
996    =cut
997    
998    sub open_diagram_image {
999        # Get the parameters.
1000        my ($self, $id) = @_;
1001        # Declare the return variables.
1002        my ($type, $fh);
1003        # Get the diagram directory.
1004        my $img_base = "$self->{dir}/diagrams/$id/diagram";
1005        # Get a list of file extensions and types.
1006        my %types = (png => "image/png",
1007                     gif => "image/gif",
1008                     jpg => "image/jpeg");
1009        # This is my new syntax for the for-each-while loop.
1010        # We loop until we run out of keys or come up with a type value.
1011        for my $ext (keys %types) { last if (defined $type);
1012            my $myType = $types{$ext};
1013            # Compute a file name for this diagram.
1014            my $file = "$img_base.$ext";
1015            # If it exists, try to open it.
1016            if (-f $file) {
1017                $fh = Open(undef, "<$file");
1018                $type = $myType;
1019            }
1020      }      }
1021        # Return the result.
1022        return ($type, $fh);
1023  }  }
1024    
1025    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3