[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.11, Mon Jul 16 19:59:33 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 121  Line 125 
125          # 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
126          # 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
127          # 2-tuples will be ordered by the spreadsheet column number.          # 2-tuples will be ordered by the spreadsheet column number.
128          my @roles = $sprout->GetAll(['OccursInSubsystem', 'Role'],          my @roles = $sprout->GetAll(['OccursInSubsystem'],
129                                      'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',                                      'OccursInSubsystem(to-link) = ? ORDER BY OccursInSubsystem(column-number)',
130                                      [$subName], ['OccursInSubsystem(from-link)', 'Role(abbr)']);                                      [$subName], ['OccursInSubsystem(from-link)', 'OccursInSubsystem(abbr)']);
131          # 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.
132          # 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.
133          # 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
134          # catalyzes.          # catalyzes.
135          my %roleHash = ();          my %roleHash = ();
136            my %abbrHash = ();
137          my %reactionHash = ();          my %reactionHash = ();
138          for ($idx = 0; $idx <= $#roles; $idx++) {          for ($idx = 0; $idx <= $#roles; $idx++) {
139              # 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 141 
141              # Put them both in the role directory.              # Put them both in the role directory.
142              $roleHash{$roleID} = $idx;              $roleHash{$roleID} = $idx;
143              $roleHash{$abbr} = $idx;              $roleHash{$abbr} = $idx;
144                # Put the full name in the abbreviation directory.
145                $abbrHash{$abbr} = $roleID;
146              # Get this role's reactions.              # Get this role's reactions.
147              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',              my @reactions = $sprout->GetFlat(['Catalyzes'], 'Catalyzes(from-link) = ?',
148                                               [$roleID], 'Catalyzes(to-link)');                                               [$roleID], 'Catalyzes(to-link)');
# Line 144  Line 151 
151                  $reactionHash{$roleID} = \@reactions;                  $reactionHash{$roleID} = \@reactions;
152              }              }
153          }          }
154            # Find the subsystem directory.
155            my $subDir = Subsystem::get_dir_from_name($subName);
156            Trace("Subsystem directory is $subDir.") if T(3);
157          # Create the subsystem object.          # Create the subsystem object.
158          $retVal = {          $retVal = {
159                      # Name of the subsystem. This is needed for any further database                      # Name of the subsystem. This is needed for any further database
160                      # accesses required.                      # accesses required.
161                      name => $subName,                      name => $subName,
162                        # Directory root for diagram and image files.
163                        dir => $subDir,
164                      # Name of the subsystem's official curator.                      # Name of the subsystem's official curator.
165                      curator => $curator,                      curator => $curator,
166                      # General notes about the subsystem.                      # General notes about the subsystem.
# Line 165  Line 177 
177                      roles => \@roles,                      roles => \@roles,
178                      # Map of PEG IDs to cluster numbers.                      # Map of PEG IDs to cluster numbers.
179                      colorHash => {},                      colorHash => {},
180                        # Map of abbreviations to role names.
181                        abbrHash => \%abbrHash,
182                      # Map of role IDs to reactions.                      # Map of role IDs to reactions.
183                      reactionHash => \%reactionHash,                      reactionHash => \%reactionHash,
184                  };                  };
# Line 222  Line 236 
236      my ($self, $gidx) = @_;      my ($self, $gidx) = @_;
237      # 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
238      # element of the tuple from the "genomes" member.      # element of the tuple from the "genomes" member.
239      my $retVal = $self->{genomes}->{$gidx}->[1];      my $retVal = $self->{genomes}->[$gidx]->[1];
240      return $retVal;      return $retVal;
241  }  }
242    
# Line 533  Line 547 
547          }          }
548      }      }
549      # Construct the spreadsheet cell ID from the information we have.      # Construct the spreadsheet cell ID from the information we have.
550      my $cellID = $self->{name} . ":$genomeID:$colIdx";      my $cellID = $sprout->DigestKey($self->{name} . ":$genomeID:$colIdx");
551      # 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.
552      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',
553                                    [$cellID], ['ContainsFeature(to-link)',                                    [$cellID], ['ContainsFeature(to-link)',
# Line 550  Line 564 
564      return @retVal;      return @retVal;
565  }  }
566    
567    =head3 get_subsetR
568    
569    C<< my @genomes = $sub->get_subsetR($subName); >>
570    
571    Return the genomes in the row subset indicated by the specified subset name.
572    
573    =over 4
574    
575    =item subName
576    
577    Name of the desired row subset, or C<All> to get all of the rows.
578    
579    =item RETURN
580    
581    Returns a list of genome IDs corresponding to the named subset.
582    
583    =back
584    
585    =cut
586    
587    sub get_subsetR {
588        # Get the parameters.
589        my ($self, $subName) = @_;
590        # Look for the specified row subset in the database. A row subset is identified using
591        # the subsystem name and the subset name. The special subset "All" is actually
592        # represented in the database, so we don't need to check for it.
593        my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
594                                            ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
595        return @rows;
596    }
597    
598  =head3 get_diagrams  =head3 get_diagrams
599    
600  C<< my @list = $sub->get_diagrams(); >>  C<< my @list = $sub->get_diagrams(); >>
# Line 588  Line 633 
633  sub get_diagrams {  sub get_diagrams {
634      # Get the parameters.      # Get the parameters.
635      my ($self) = @_;      my ($self) = @_;
     # Find the subsystem directory.  
     my $subDir = Subsystem::get_dir_from_name($self->{name});  
636      # Get the diagram IDs.      # Get the diagram IDs.
637      my @diagramIDs = Subsystem::GetDiagramIDs($subDir);      my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir});
638        Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3);
639      # Create the return variable.      # Create the return variable.
640      my @retVal = ();      my @retVal = ();
641      # Loop through the diagram IDs.      # Loop through the diagram IDs.
642      for my $diagramID (@diagramIDs) {      for my $diagramID (@diagramIDs) {
643          # Get the diagram name.          Trace("Processing diagram $diagramID.") if T(3);
644          my $name = Subsystem::GetDiagramName($diagramID);          my ($name, $link, $imgLink) = $self->get_diagram($diagramID);
645          # 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);  
646              push @retVal, [$diagramID, $name, $link, $imgLink];              push @retVal, [$diagramID, $name, $link, $imgLink];
647          }          }
648        # Return the result.
649        return @retVal;
650    }
651    
652    =head3 get_diagram
653    
654    C<< my ($name, $pageURL, $imgURL) = $sub->get_diagram($id); >>
655    
656    Get the information (if any) for the specified diagram. The diagram corresponds
657    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
658    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
659    where I<$dir> is the subsystem directory. The diagram's name is extracted from
660    a tiny file containing the name, and then the links are computed using the
661    subsystem name and the diagram ID. The parameters are as follows.
662    
663    =over 4
664    
665    =item id
666    
667    ID code for the desired diagram.
668    
669    =item RETURN
670    
671    Returns a three-element list. The first element is the diagram name, the second
672    a URL for displaying information about the diagram, and the third a URL for
673    displaying the diagram image.
674    
675    =back
676    
677    =cut
678    
679    sub get_diagram {
680        my($self, $id) = @_;
681        my $name = Subsystem::GetDiagramName($self->{dir}, $id);
682        my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self, $self->{name}, $id, 1);
683        return($name, $link, $img_link);
684    }
685    
686    
687    =head3 get_diagram_html_file
688    
689    C<< my $fileName = $sub->get_diagram_html_file($id); >>
690    
691    Get the HTML file (if any) for the specified diagram. The diagram corresponds
692    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
693    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
694    where I<$dir> is the subsystem directory. If an HTML file exists, it will be
695    named C<diagram.html> in the diagram directory.  The parameters are as follows.
696    
697    =over 4
698    
699    =item id
700    
701    ID code for the desired diagram.
702    
703    =item RETURN
704    
705    Returns the name of an HTML diagram file, or C<undef> if no such file exists.
706    
707    =back
708    
709    =cut
710    
711    sub get_diagram_html_file {
712        my ($self, $id) = @_;
713        my $retVal;
714        my $ddir = "$self->{dir}/diagrams/$id";
715        if (-d $ddir) {
716            my $html = "$ddir/diagram.html";
717            if (-f $html) {
718                $retVal = $html;
719            }
720        }
721        return $retVal;
722    }
723    
724    =head3 is_new_diagram
725    
726    C<< my $flag = $sub->is_new_diagram($id); >>
727    
728    Return TRUE if the specified diagram is in the new format, else FALSE.
729    
730    =over 4
731    
732    =item id
733    
734    ID code (e.g. C<d03>) of the relevant diagram.
735    
736    =item RETURN
737    
738    Returns TRUE if the diagram is in the new format, else FALSE.
739    
740    =back
741    
742    =cut
743    
744    sub is_new_diagram {
745      my ($self, $id) = @_;
746    
747      my $image_map = $self->get_diagram_html_file($id);
748      if ($image_map) {
749        Trace("Image map found for diagram $id at $image_map.") if T(3);
750        open(IN, "$image_map") or Confess("Unable to open file $image_map.");
751        my $header = <IN>;
752        close(IN);
753    
754        if ($header =~ /\<map name=\"GraffleExport\"\>/) {
755          return 1;
756        }
757      }
758    
759      return undef;
760    }
761    
762    =head3 get_role_from_abbr
763    
764    C<< my $roleName = $sub->get_role_from_abbr($abbr); >>
765    
766    Return the role name corresponding to an abbreviation.
767    
768    =over 4
769    
770    =item abbr
771    
772    Abbreviation name of the relevant role.
773    
774    =item RETURN
775    
776    Returns the full name of the specified role.
777    
778    =back
779    
780    =cut
781    
782    sub get_role_from_abbr {
783        # Get the parameters.
784        my($self, $abbr) = @_;
785        # Get the role name from the abbreviation hash.
786        my $retVal = $self->{abbrHash}->{$abbr};
787        # Check for a case incompatability.
788        if (! defined $retVal) {
789            $retVal = $self->{abbrHash}->{lcfirst $abbr};
790        }
791        # Return the result.
792        return $retVal;
793      }      }
794    
795    
796    =head3 get_name
797    
798    C<< my $name = $sub->get_name(); >>
799    
800    Return the name of this subsystem.
801    
802    =cut
803    
804    sub get_name {
805        # Get the parameters.
806        my ($self) = @_;
807        # Return the result.
808        return $self->{name};
809    }
810    
811    =head3 open_diagram_image
812    
813    C<< my ($type, $fh) = $sub->open_diagram_image($id); >>
814    
815    Open a diagram's image file and return the type and file handle.
816    
817    =over 4
818    
819    =item id
820    
821    ID of the desired diagram
822    
823    =item RETURN
824    
825    Returns a 2-tuple containing the diagram's MIME type and an open filehandle
826    for the diagram's data. If the diagram does not exist, the type will be
827    returned as <undef>.
828    
829    =back
830    
831    =cut
832    
833    sub open_diagram_image {
834        # Get the parameters.
835        my ($self, $id) = @_;
836        # Declare the return variables.
837        my ($type, $fh);
838        # Get the diagram directory.
839        my $img_base = "$self->{dir}/diagrams/$id/diagram";
840        # Get a list of file extensions and types.
841        my %types = (png => "image/png",
842                     gif => "image/gif",
843                     jpg => "image/jpeg");
844        # This is my new syntax for the for-each-while loop.
845        # We loop until we run out of keys or come up with a type value.
846        for my $ext (keys %types) { last if (defined $type);
847            my $myType = $types{$ext};
848            # Compute a file name for this diagram.
849            my $file = "$img_base.$ext";
850            # If it exists, try to open it.
851            if (-f $file) {
852                $fh = Open(undef, "<$file");
853                $type = $myType;
854            }
855        }
856        # Return the result.
857        return ($type, $fh);
858  }  }
859    
860    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3