[Bio] / FigKernelPackages / ServerThing.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/ServerThing.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.39, Tue Mar 16 19:50:43 2010 UTC revision 1.47, Tue Apr 13 20:05:49 2010 UTC
# Line 468  Line 468 
468      my $testFileName = "$FIG_Config::organisms/$genomeA/CorrToReferenceGenomes/$genomeB";      my $testFileName = "$FIG_Config::organisms/$genomeA/CorrToReferenceGenomes/$genomeB";
469      if (0 && -f $testFileName) {      if (0 && -f $testFileName) {
470          # Use the pre-computed file.          # Use the pre-computed file.
471          Trace("Using pre-computed file $fileName for genome correspondence.") if T(3);          Trace("Using pre-computed file $fileName for genome correspondence.") if T(Corr => 3);
472          $fileName = $testFileName;          $fileName = $testFileName;
473      } elsif (-f $corrFileName) {      } elsif (-f $corrFileName) {
474          $fileName = $corrFileName;          $fileName = $corrFileName;
475          Trace("Using cached file $fileName for genome correspondence.") if T(3);          Trace("Using cached file $fileName for genome correspondence.") if T(Corr => 3);
476      }      }
477      # Return the result.      # Return the result.
478      return ($fileName, $converse);      return ($fileName, $converse);
# Line 513  Line 513 
513      # Declare the return variables.      # Declare the return variables.
514      my ($fileName, $genomeA, $genomeB);      my ($fileName, $genomeA, $genomeB);
515      # Determine the ordering of the genome IDs.      # Determine the ordering of the genome IDs.
516      if ($genome1 lt $genome2) {      if (MustFlipGenomeIDs($genome1, $genome2)) {
         ($genomeA, $genomeB) = ($genome1, $genome2);  
     } else {  
517          ($genomeA, $genomeB) = ($genome2, $genome1);          ($genomeA, $genomeB) = ($genome2, $genome1);
518        } else {
519            ($genomeA, $genomeB) = ($genome1, $genome2);
520      }      }
521      # Insure the source organism has a subdirectory in the organism cache.      # Insure the source organism has a subdirectory in the organism cache.
522      my $orgDir = "$FIG_Config::orgCache/$genomeA";      my $orgDir = ComputeCorrespondenceDirectory($genomeA);
     Tracer::Insure($orgDir, 0777);  
523      # Compute the name of the correspondence file for the appropriate target genome.      # Compute the name of the correspondence file for the appropriate target genome.
524      $fileName = "$orgDir/$genomeB";      $fileName = "$orgDir/$genomeB";
525      # Return the results.      # Return the results.
# Line 528  Line 527 
527  }  }
528    
529    
530    =head3 ComputeCorresopndenceDirectory
531    
532        my $dirName = ServerThing::ComputeCorrespondenceDirectory($genome);
533    
534    Return the name of the directory that would contain the correspondence files
535    for the specified genome.
536    
537    =over 4
538    
539    =item genome
540    
541    ID of the genome whose correspondence file directory is desired.
542    
543    =item RETURN
544    
545    Returns the name of the directory of interest.
546    
547    =back
548    
549    =cut
550    
551    sub ComputeCorrespondenceDirectory {
552        # Get the parameters.
553        my ($genome) = @_;
554        # Insure the source organism has a subdirectory in the organism cache.
555        my $retVal = "$FIG_Config::orgCache/$genome";
556        Tracer::Insure($retVal, 0777);
557        # Return it.
558        return $retVal;
559    }
560    
561    
562  =head3 CreateGeneCorrespondenceFile  =head3 CreateGeneCorrespondenceFile
563    
564      my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);      my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);
# Line 599  Line 630 
630              # Everything is ok, fix the permissions and return the file name.              # Everything is ok, fix the permissions and return the file name.
631              chmod 0664, $corrFileName;              chmod 0664, $corrFileName;
632              $fileName = $corrFileName;              $fileName = $corrFileName;
633              Trace("Created correspondence file $fileName.") if T(3);              Trace("Created correspondence file $fileName.") if T(Corr => 3);
634          }          }
635      }      }
636      # If the temporary file exists, delete it.      # If the temporary file exists, delete it.
# Line 611  Line 642 
642  }  }
643    
644    
645    =head3 MustFlipGenomeIDs
646    
647        my $converse = ServerThing::MustFlipGenomeIDs($genome1, $genome2);
648    
649    Return TRUE if the specified genome IDs are out of order. When genome IDs are out of
650    order, they are stored in the converse order in correspondence files on the server.
651    This is a simple method that allows the caller to check for the need to flip.
652    
653    =over 4
654    
655    =item genome1
656    
657    ID of the proposed source genome.
658    
659    =item genome2
660    
661    ID of the proposed target genome.
662    
663    =item RETURN
664    
665    Returns TRUE if the first genome would be stored on the server as a target, FALSE if
666    it would be stored as a source.
667    
668    =cut
669    
670    sub MustFlipGenomeIDs {
671        # Get the parameters.
672        my ($genome1, $genome2) = @_;
673        # Return an indication.
674        return ($genome1 gt $genome2);
675    }
676    
677    
678  =head3 ReadGeneCorrespondenceFile  =head3 ReadGeneCorrespondenceFile
679    
680      my $list = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse);      my $list = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse, $all);
681    
682  Return the contents of the specified gene correspondence file in the form of  Return the contents of the specified gene correspondence file in the form of
683  a list of lists, with backward correspondences filtered out. If the file is  a list of lists, with backward correspondences filtered out. If the file is
# Line 633  Line 697 
697  If TRUE, the file columns will be reorderd automatically. The default is FALSE,  If TRUE, the file columns will be reorderd automatically. The default is FALSE,
698  meaning we want to use the file as it appears on disk.  meaning we want to use the file as it appears on disk.
699    
700    =item all (optional)
701    
702    TRUE if backward unidirectional correspondences should be included in the output.
703    The default is FALSE, in which case only forward and bidirectional correspondences
704    are included.
705    
706  =item RETURN  =item RETURN
707    
708  Returns a L</Gene Correspondence List> in the form of a reference to a list of lists.  Returns a L</Gene Correspondence List> in the form of a reference to a list of lists.
# Line 645  Line 715 
715    
716  sub ReadGeneCorrespondenceFile {  sub ReadGeneCorrespondenceFile {
717      # Get the parameters.      # Get the parameters.
718      my ($fileName, $converse) = @_;      my ($fileName, $converse, $all) = @_;
719      # Declare the return variable. We will only put something in here if we are      # Declare the return variable. We will only put something in here if we are
720      # completely successful.      # completely successful.
721      my $retVal;      my $retVal;
# Line 656  Line 726 
726      Trace("Reading correspondence file $fileName.") if T(3);      Trace("Reading correspondence file $fileName.") if T(3);
727      if (! open $ih, "<$fileName") {      if (! open $ih, "<$fileName") {
728          # Here the open failed, so we have an error.          # Here the open failed, so we have an error.
729          Trace("Failed to open gene correspondence file $fileName: $!") if T(3);          Trace("Failed to open gene correspondence file $fileName: $!") if T(Corr => 1);
730          $error = 1;          $error = 1;
731      }      }
732      # The gene correspondence list will be built in here.      # The gene correspondence list will be built in here.
# Line 677  Line 747 
747          }          }
748          # Validate the row.          # Validate the row.
749          if (ValidateGeneCorrespondenceRow(\@row)) {          if (ValidateGeneCorrespondenceRow(\@row)) {
750              Trace("Invalid row $. found in correspondence file $fileName.") if T(3);              Trace("Invalid row $. found in correspondence file $fileName.") if T(Corr => 1);
751              $error = 1;              $error = 1;
752          }          }
753          # If this row is in the correct direction, keep it.          # If this row is in the correct direction, keep it.
754          if ($row[8] ne '<-') {          if ($all || $row[8] ne '<-') {
755              push @corrList, \@row;              push @corrList, \@row;
756          }          }
757      }      }
# Line 692  Line 762 
762          if ($reverseFound) {          if ($reverseFound) {
763              $retVal = \@corrList;              $retVal = \@corrList;
764          } else {          } else {
765              Trace("No reverse arrow found in correspondence file $fileName.") if T(3);              Trace("No reverse arrow found in correspondence file $fileName.") if T(Corr => 1);
766          }          }
767      }      }
768      # Return the result (if any).      # Return the result (if any).
# Line 722  Line 792 
792      my ($row) = @_;      my ($row) = @_;
793      # Flip the row in place.      # Flip the row in place.
794      ($row->[1], $row->[0], $row->[2], $row->[3], $row->[5], $row->[4], $row->[7],      ($row->[1], $row->[0], $row->[2], $row->[3], $row->[5], $row->[4], $row->[7],
795       $row->[6], ARROW_FLIP->{$row->[8]}, $row->[9], $row->[10], $row->[14],       $row->[6], $row->[8], $row->[9], $row->[10], $row->[14],
796       $row->[15], $row->[16], $row->[11], $row->[12], $row->[13], $row->[17]) = @$row;       $row->[15], $row->[16], $row->[11], $row->[12], $row->[13], $row->[17]) = @$row;
797        # Flip the arrow.
798        $row->[8] = ARROW_FLIP->{$row->[8]};
799        # Flip the pairs.
800        my @elements = split /,/, $row->[3];
801        $row->[3] = join(",", map { join(":", reverse split /:/, $_) } @elements);
802  }  }
803    
804  =head3 ValidateGeneCorrespondenceRow  =head3 ValidateGeneCorrespondenceRow
# Line 757  Line 832 
832      # Check for non-numeric values in the number columns.      # Check for non-numeric values in the number columns.
833      for my $col (@{NUM_COLS()}) {      for my $col (@{NUM_COLS()}) {
834          unless ($row->[$col] =~ /^-?\d+\.?\d*(?:e[+-]?\d+)?$/) {          unless ($row->[$col] =~ /^-?\d+\.?\d*(?:e[+-]?\d+)?$/) {
835                Trace("Gene correspondence error. \"$row->[$col]\" not numeric.") if T(Corr => 2);
836              $retVal++;              $retVal++;
837          }          }
838      }      }
839      # Check the gene IDs.      # Check the gene IDs.
840      for my $col (0, 1) {      for my $col (0, 1) {
841          unless ($row->[$col] =~ /^fig\|\d+\.\d+\.\w+\.\d+$/) {          unless ($row->[$col] =~ /^fig\|\d+\.\d+\.\w+\.\d+$/) {
842                Trace("Gene correspondence error. \"$row->[$col]\" not a gene ID.") if T(Corr => 2);
843              $retVal++;              $retVal++;
844          }          }
845      }      }
846      # Verify the arrow.      # Verify the arrow.
847      unless (exists ARROW_FLIP->{$row->[8]}) {      unless (exists ARROW_FLIP->{$row->[8]}) {
848            Trace("Gene correspondence error. \"$row->[8]\" not an arrow.") if T(Corr => 2);
849          $retVal++;          $retVal++;
850      }      }
851      # Return the error count.      # Return the error count.
# Line 1029  Line 1107 
1107      my ($module) = @_;      my ($module) = @_;
1108      # Start the output page.      # Start the output page.
1109      print CGI::header();      print CGI::header();
1110      print CGI::start_html(-title => 'Documentation Page',      print CGI::start_html(-title => "$module Documentation Page",
1111                            -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });                            -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });
1112      # Protect from errors.      # Protect from errors.
1113      eval {      eval {

Legend:
Removed from v.1.39  
changed lines
  Added in v.1.47

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3