[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.10, Tue Apr 10 06:16:22 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 144  Line 148 
148                  $reactionHash{$roleID} = \@reactions;                  $reactionHash{$roleID} = \@reactions;
149              }              }
150          }          }
151            # Find the subsystem directory.
152            my $subDir = Subsystem::get_dir_from_name($subName);
153            Trace("Subsystem directory is $subDir.") if T(3);
154          # Create the subsystem object.          # Create the subsystem object.
155          $retVal = {          $retVal = {
156                      # Name of the subsystem. This is needed for any further database                      # Name of the subsystem. This is needed for any further database
157                      # accesses required.                      # accesses required.
158                      name => $subName,                      name => $subName,
159                        # Directory root for diagram and image files.
160                        dir => $subDir,
161                      # Name of the subsystem's official curator.                      # Name of the subsystem's official curator.
162                      curator => $curator,                      curator => $curator,
163                      # General notes about the subsystem.                      # General notes about the subsystem.
# Line 222  Line 231 
231      my ($self, $gidx) = @_;      my ($self, $gidx) = @_;
232      # 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
233      # element of the tuple from the "genomes" member.      # element of the tuple from the "genomes" member.
234      my $retVal = $self->{genomes}->{$gidx}->[1];      my $retVal = $self->{genomes}->[$gidx]->[1];
235      return $retVal;      return $retVal;
236  }  }
237    
# Line 533  Line 542 
542          }          }
543      }      }
544      # Construct the spreadsheet cell ID from the information we have.      # Construct the spreadsheet cell ID from the information we have.
545      my $cellID = $self->{name} . ":$genomeID:$colIdx";      my $cellID = $sprout->DigestKey($self->{name} . ":$genomeID:$colIdx");
546      # 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.
547      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',      my @pegList = $sprout->GetAll(['ContainsFeature'], 'ContainsFeature(from-link) = ?',
548                                    [$cellID], ['ContainsFeature(to-link)',                                    [$cellID], ['ContainsFeature(to-link)',
# Line 550  Line 559 
559      return @retVal;      return @retVal;
560  }  }
561    
562    =head3 get_subsetR
563    
564    C<< my @genomes = $sub->get_subsetR($subName); >>
565    
566    Return the genomes in the row subset indicated by the specified subset name.
567    
568    =over 4
569    
570    =item subName
571    
572    Name of the desired row subset, or C<All> to get all of the rows.
573    
574    =item RETURN
575    
576    Returns a list of genome IDs corresponding to the named subset.
577    
578    =back
579    
580    =cut
581    
582    sub get_subsetR {
583        # Get the parameters.
584        my ($self, $subName) = @_;
585        # Look for the specified row subset in the database. A row subset is identified using
586        # the subsystem name and the subset name. The special subset "All" is actually
587        # represented in the database, so we don't need to check for it.
588        my @rows = $self->{sprout}->GetFlat(['ConsistsOfGenomes'], "ConsistsOfGenomes(from-link) = ?",
589                                            ["$self->{name}:$subName"], 'ConsistsOfGenomes(to-link)');
590        return @rows;
591    }
592    
593  =head3 get_diagrams  =head3 get_diagrams
594    
595  C<< my @list = $sub->get_diagrams(); >>  C<< my @list = $sub->get_diagrams(); >>
# Line 588  Line 628 
628  sub get_diagrams {  sub get_diagrams {
629      # Get the parameters.      # Get the parameters.
630      my ($self) = @_;      my ($self) = @_;
     # Find the subsystem directory.  
     my $subDir = Subsystem::get_dir_from_name($self->{name});  
631      # Get the diagram IDs.      # Get the diagram IDs.
632      my @diagramIDs = Subsystem::GetDiagramIDs($subDir);      my @diagramIDs = Subsystem::GetDiagramIDs($self->{dir});
633        Trace("Diagram IDs are " . join(", ", @diagramIDs)) if T(3);
634      # Create the return variable.      # Create the return variable.
635      my @retVal = ();      my @retVal = ();
636      # Loop through the diagram IDs.      # Loop through the diagram IDs.
637      for my $diagramID (@diagramIDs) {      for my $diagramID (@diagramIDs) {
638          # Get the diagram name.          Trace("Processing diagram $diagramID.") if T(3);
639          my $name = Subsystem::GetDiagramName($diagramID);          my ($name, $link, $imgLink) = $self->get_diagram($diagramID);
640          # 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);  
641              push @retVal, [$diagramID, $name, $link, $imgLink];              push @retVal, [$diagramID, $name, $link, $imgLink];
642          }          }
643        # Return the result.
644        return @retVal;
645    }
646    
647    =head3 get_diagram
648    
649    C<< my ($name, $pageURL, $imgURL) = $sub->get_diagram($id); >>
650    
651    Get the information (if any) for the specified diagram. The diagram corresponds
652    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
653    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
654    where I<$dir> is the subsystem directory. The diagram's name is extracted from
655    a tiny file containing the name, and then the links are computed using the
656    subsystem name and the diagram ID. The parameters are as follows.
657    
658    =over 4
659    
660    =item id
661    
662    ID code for the desired diagram.
663    
664    =item RETURN
665    
666    Returns a three-element list. The first element is the diagram name, the second
667    a URL for displaying information about the diagram, and the third a URL for
668    displaying the diagram image.
669    
670    =back
671    
672    =cut
673    
674    sub get_diagram {
675        my($self, $id) = @_;
676        my $name = Subsystem::GetDiagramName($self->{dir}, $id);
677        my ($link, $img_link) = Subsystem::ComputeDiagramURLs($self->{name}, $id, 1);
678        return($name, $link, $img_link);
679    }
680    
681    
682    =head3 get_diagram_html_file
683    
684    C<< my $fileName = $sub->get_diagram_html_file($id); >>
685    
686    Get the HTML file (if any) for the specified diagram. The diagram corresponds
687    to a subdirectory of the subsystem's C<diagrams> directory. For example, if the
688    diagram ID is C<d03>, the diagram's subdirectory would be C<$dir/diagrams/d03>,
689    where I<$dir> is the subsystem directory. If an HTML file exists, it will be
690    named C<diagram.html> in the diagram directory.  The parameters are as follows.
691    
692    =over 4
693    
694    =item id
695    
696    ID code for the desired diagram.
697    
698    =item RETURN
699    
700    Returns the name of an HTML diagram file, or C<undef> if no such file exists.
701    
702    =back
703    
704    =cut
705    
706    sub get_diagram_html_file {
707        my ($self, $id) = @_;
708        my $retVal;
709        my $ddir = "$self->{dir}/diagrams/$id";
710        if (-d $ddir) {
711            my $html = "$ddir/diagram.html";
712            if (-f $html) {
713                $retVal = $html;
714            }
715        }
716        return $retVal;
717      }      }
718    
719    =head3 get_name
720    
721    C<< my $name = $sub->get_name(); >>
722    
723    Return the name of this subsystem.
724    
725    =cut
726    
727    sub get_name {
728        # Get the parameters.
729        my ($self) = @_;
730        # Return the result.
731        return $self->{name};
732    }
733    
734    =head3 open_diagram_image
735    
736    C<< my ($type, $fh) = $sub->open_diagram_image($id); >>
737    
738    Open a diagram's image file and return the type and file handle.
739    
740    =over 4
741    
742    =item id
743    
744    ID of the desired diagram
745    
746    =item RETURN
747    
748    Returns a 2-tuple containing the diagram's MIME type and an open filehandle
749    for the diagram's data. If the diagram does not exist, the type will be
750    returned as <undef>.
751    
752    =back
753    
754    =cut
755    
756    sub open_diagram_image {
757        # Get the parameters.
758        my ($self, $id) = @_;
759        # Declare the return variables.
760        my ($type, $fh);
761        # Get the diagram directory.
762        my $img_base = "$self->{dir}/diagrams/$id/diagram";
763        # Get a list of file extensions and types.
764        my %types = (png => "image/png",
765                     gif => "image/gif",
766                     jpg => "image/jpeg");
767        # This is my new syntax for the for-each-while loop.
768        # We loop until we run out of keys or come up with a type value.
769        for my $ext (keys %types) { last if (defined $type);
770            my $myType = $types{$ext};
771            # Compute a file name for this diagram.
772            my $file = "$img_base.$ext";
773            # If it exists, try to open it.
774            if (-f $file) {
775                $fh = Open(undef, "<$file");
776                $type = $myType;
777            }
778        }
779        # Return the result.
780        return ($type, $fh);
781  }  }
782    
783    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3