[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.38, Sun Mar 14 14:30:12 2010 UTC revision 1.49, Wed Apr 28 14:02:11 2010 UTC
# Line 14  Line 14 
14      no warnings qw(once);      no warnings qw(once);
15    
16      # Maximum number of requests to run per invocation.      # Maximum number of requests to run per invocation.
17      use constant MAX_REQUESTS => 5000;      use constant MAX_REQUESTS => 50;
18    
19  =head1 General Server Helper  =head1 General Server Helper
20    
# 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 673  Line 743 
743          $reverseFound = 1 if ($row[8] eq '<-');          $reverseFound = 1 if ($row[8] eq '<-');
744          # If we're in converse mode, reformat the line.          # If we're in converse mode, reformat the line.
745          if ($converse) {          if ($converse) {
746              ($row[1], $row[0], $row[2], $row[3], $row[5], $row[4], $row[7], $row[6],              ReverseGeneCorrespondenceRow(\@row);
              ARROW_FLIP->{$row[8]}, $row[9], $row[10], $row[14], $row[15], $row[16],  
              $row[11], $row[12], $row[13], $row[17]) = @row;  
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 694  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).
769      return $retVal;      return $retVal;
770  }  }
771    
772    =head3 ReverseGeneCorrespondenceRow
773    
774        ServerThing::ReverseGeneCorrespondenceRow($row)
775    
776    Convert a gene correspondence row to represent the converse correspondence. The
777    elements in the row will be reordered to represent a correspondence from the
778    target genome to the source genome.
779    
780    =over 4
781    
782    =item row
783    
784    Reference to a list containing a single row from a L</Gene Correspondence List>.
785    
786    =back
787    
788    =cut
789    
790    sub ReverseGeneCorrespondenceRow {
791        # Get the parameters.
792        my ($row) = @_;
793        # Flip the row in place.
794        ($row->[1], $row->[0], $row->[2], $row->[3], $row->[5], $row->[4], $row->[7],
795         $row->[6], $row->[8], $row->[9], $row->[10], $row->[14],
796         $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
805    
# Line 733  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 766  Line 868 
868    
869  =item cgi  =item cgi
870    
871  CGI query object containing the parameters from the web service request.  CGI query object containing the parameters from the web service request. The
872    significant parameters are as follows.
873    
874    =over 8
875    
876    =item function
877    
878    Name of the function to run.
879    
880    =item args
881    
882    Parameters for the function.
883    
884    =item encoding
885    
886    Encoding scheme for the function parameters, either C<yaml> (the default) or C<json> (used
887    by the Java interface).
888    
889    =back
890    
891    Certain unusual requests can come in outside of the standard function interface.
892    These are indicated by special parameters that override all the others.
893    
894    =over 8
895    
896    =item pod
897    
898    Display a POD documentation module.
899    
900    =item code
901    
902    Display an example code file.
903    
904    =item file
905    
906    Transfer a file (not implemented).
907    
908    =back
909    
910  =item serverThing  =item serverThing
911    
# Line 817  Line 956 
956          my $sapling;          my $sapling;
957          # Protect from errors.          # Protect from errors.
958          eval {          eval {
959              # Parse the arguments.              # Here we parse the arguments. This is affected by the encoding parameter.
960              $args = YAML::Load($cgi->param('args'));              # The default is YAML.
961                my $encoding = $cgi->param('encoding') || 'yaml';
962                # Get the argument string.
963                my $argString = $cgi->param('args');
964                if ($encoding eq 'yaml') {
965                    # Parse the arguments using YAML.
966                    $args = YAML::Load($argString);
967                } elsif ($encoding eq 'json') {
968                    # Parse the arguments using JSON.
969                    require JSON::Any;
970                    $args = JSON::Any->jsonToObj($argString);
971                } else {
972                    Die("Invalid encoding type $encoding.");
973                }
974          };          };
975          # Check to make sure we got everything.          # Check to make sure we got everything.
976          if ($@) {          if ($@) {
# Line 1005  Line 1157 
1157      my ($module) = @_;      my ($module) = @_;
1158      # Start the output page.      # Start the output page.
1159      print CGI::header();      print CGI::header();
1160      print CGI::start_html(-title => 'Documentation Page',      print CGI::start_html(-title => "$module Documentation Page",
1161                            -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });                            -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });
1162      # Protect from errors.      # Protect from errors.
1163      eval {      eval {

Legend:
Removed from v.1.38  
changed lines
  Added in v.1.49

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3