[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.40, Tue Mar 16 20:24:05 2010 UTC revision 1.50, Wed Apr 28 15:31:12 2010 UTC
# Line 5  Line 5 
5      use strict;      use strict;
6      use Tracer;      use Tracer;
7      use YAML;      use YAML;
8        use JSON::Any;
9      use ERDB;      use ERDB;
10      use TestUtils;      use TestUtils;
11      use Time::HiRes;      use Time::HiRes;
# Line 14  Line 15 
15      no warnings qw(once);      no warnings qw(once);
16    
17      # Maximum number of requests to run per invocation.      # Maximum number of requests to run per invocation.
18      use constant MAX_REQUESTS => 5000;      use constant MAX_REQUESTS => 50;
19    
20  =head1 General Server Helper  =head1 General Server Helper
21    
# Line 468  Line 469 
469      my $testFileName = "$FIG_Config::organisms/$genomeA/CorrToReferenceGenomes/$genomeB";      my $testFileName = "$FIG_Config::organisms/$genomeA/CorrToReferenceGenomes/$genomeB";
470      if (0 && -f $testFileName) {      if (0 && -f $testFileName) {
471          # Use the pre-computed file.          # Use the pre-computed file.
472          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);
473          $fileName = $testFileName;          $fileName = $testFileName;
474      } elsif (-f $corrFileName) {      } elsif (-f $corrFileName) {
475          $fileName = $corrFileName;          $fileName = $corrFileName;
476          Trace("Using cached file $fileName for genome correspondence.") if T(3);          Trace("Using cached file $fileName for genome correspondence.") if T(Corr => 3);
477      }      }
478      # Return the result.      # Return the result.
479      return ($fileName, $converse);      return ($fileName, $converse);
# Line 513  Line 514 
514      # Declare the return variables.      # Declare the return variables.
515      my ($fileName, $genomeA, $genomeB);      my ($fileName, $genomeA, $genomeB);
516      # Determine the ordering of the genome IDs.      # Determine the ordering of the genome IDs.
517      if ($genome1 lt $genome2) {      if (MustFlipGenomeIDs($genome1, $genome2)) {
         ($genomeA, $genomeB) = ($genome1, $genome2);  
     } else {  
518          ($genomeA, $genomeB) = ($genome2, $genome1);          ($genomeA, $genomeB) = ($genome2, $genome1);
519        } else {
520            ($genomeA, $genomeB) = ($genome1, $genome2);
521      }      }
522      # Insure the source organism has a subdirectory in the organism cache.      # Insure the source organism has a subdirectory in the organism cache.
523      my $orgDir = "$FIG_Config::orgCache/$genomeA";      my $orgDir = ComputeCorrespondenceDirectory($genomeA);
     Tracer::Insure($orgDir, 0777);  
524      # Compute the name of the correspondence file for the appropriate target genome.      # Compute the name of the correspondence file for the appropriate target genome.
525      $fileName = "$orgDir/$genomeB";      $fileName = "$orgDir/$genomeB";
526      # Return the results.      # Return the results.
# Line 528  Line 528 
528  }  }
529    
530    
531    =head3 ComputeCorresopndenceDirectory
532    
533        my $dirName = ServerThing::ComputeCorrespondenceDirectory($genome);
534    
535    Return the name of the directory that would contain the correspondence files
536    for the specified genome.
537    
538    =over 4
539    
540    =item genome
541    
542    ID of the genome whose correspondence file directory is desired.
543    
544    =item RETURN
545    
546    Returns the name of the directory of interest.
547    
548    =back
549    
550    =cut
551    
552    sub ComputeCorrespondenceDirectory {
553        # Get the parameters.
554        my ($genome) = @_;
555        # Insure the source organism has a subdirectory in the organism cache.
556        my $retVal = "$FIG_Config::orgCache/$genome";
557        Tracer::Insure($retVal, 0777);
558        # Return it.
559        return $retVal;
560    }
561    
562    
563  =head3 CreateGeneCorrespondenceFile  =head3 CreateGeneCorrespondenceFile
564    
565      my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);      my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);
# Line 599  Line 631 
631              # Everything is ok, fix the permissions and return the file name.              # Everything is ok, fix the permissions and return the file name.
632              chmod 0664, $corrFileName;              chmod 0664, $corrFileName;
633              $fileName = $corrFileName;              $fileName = $corrFileName;
634              Trace("Created correspondence file $fileName.") if T(3);              Trace("Created correspondence file $fileName.") if T(Corr => 3);
635          }          }
636      }      }
637      # If the temporary file exists, delete it.      # If the temporary file exists, delete it.
# Line 611  Line 643 
643  }  }
644    
645    
646    =head3 MustFlipGenomeIDs
647    
648        my $converse = ServerThing::MustFlipGenomeIDs($genome1, $genome2);
649    
650    Return TRUE if the specified genome IDs are out of order. When genome IDs are out of
651    order, they are stored in the converse order in correspondence files on the server.
652    This is a simple method that allows the caller to check for the need to flip.
653    
654    =over 4
655    
656    =item genome1
657    
658    ID of the proposed source genome.
659    
660    =item genome2
661    
662    ID of the proposed target genome.
663    
664    =item RETURN
665    
666    Returns TRUE if the first genome would be stored on the server as a target, FALSE if
667    it would be stored as a source.
668    
669    =cut
670    
671    sub MustFlipGenomeIDs {
672        # Get the parameters.
673        my ($genome1, $genome2) = @_;
674        # Return an indication.
675        return ($genome1 gt $genome2);
676    }
677    
678    
679  =head3 ReadGeneCorrespondenceFile  =head3 ReadGeneCorrespondenceFile
680    
681      my $list = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse, $all);      my $list = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse, $all);
# Line 662  Line 727 
727      Trace("Reading correspondence file $fileName.") if T(3);      Trace("Reading correspondence file $fileName.") if T(3);
728      if (! open $ih, "<$fileName") {      if (! open $ih, "<$fileName") {
729          # Here the open failed, so we have an error.          # Here the open failed, so we have an error.
730          Trace("Failed to open gene correspondence file $fileName: $!") if T(3);          Trace("Failed to open gene correspondence file $fileName: $!") if T(Corr => 1);
731          $error = 1;          $error = 1;
732      }      }
733      # The gene correspondence list will be built in here.      # The gene correspondence list will be built in here.
# Line 683  Line 748 
748          }          }
749          # Validate the row.          # Validate the row.
750          if (ValidateGeneCorrespondenceRow(\@row)) {          if (ValidateGeneCorrespondenceRow(\@row)) {
751              Trace("Invalid row $. found in correspondence file $fileName.") if T(3);              Trace("Invalid row $. found in correspondence file $fileName.") if T(Corr => 1);
752              $error = 1;              $error = 1;
753          }          }
754          # If this row is in the correct direction, keep it.          # If this row is in the correct direction, keep it.
# Line 698  Line 763 
763          if ($reverseFound) {          if ($reverseFound) {
764              $retVal = \@corrList;              $retVal = \@corrList;
765          } else {          } else {
766              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);
767          }          }
768      }      }
769      # Return the result (if any).      # Return the result (if any).
# Line 728  Line 793 
793      my ($row) = @_;      my ($row) = @_;
794      # Flip the row in place.      # Flip the row in place.
795      ($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],
796       $row->[6], ARROW_FLIP->{$row->[8]}, $row->[9], $row->[10], $row->[14],       $row->[6], $row->[8], $row->[9], $row->[10], $row->[14],
797       $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;
798        # Flip the arrow.
799        $row->[8] = ARROW_FLIP->{$row->[8]};
800        # Flip the pairs.
801        my @elements = split /,/, $row->[3];
802        $row->[3] = join(",", map { join(":", reverse split /:/, $_) } @elements);
803  }  }
804    
805  =head3 ValidateGeneCorrespondenceRow  =head3 ValidateGeneCorrespondenceRow
# Line 763  Line 833 
833      # Check for non-numeric values in the number columns.      # Check for non-numeric values in the number columns.
834      for my $col (@{NUM_COLS()}) {      for my $col (@{NUM_COLS()}) {
835          unless ($row->[$col] =~ /^-?\d+\.?\d*(?:e[+-]?\d+)?$/) {          unless ($row->[$col] =~ /^-?\d+\.?\d*(?:e[+-]?\d+)?$/) {
836                Trace("Gene correspondence error. \"$row->[$col]\" not numeric.") if T(Corr => 2);
837              $retVal++;              $retVal++;
838          }          }
839      }      }
840      # Check the gene IDs.      # Check the gene IDs.
841      for my $col (0, 1) {      for my $col (0, 1) {
842          unless ($row->[$col] =~ /^fig\|\d+\.\d+\.\w+\.\d+$/) {          unless ($row->[$col] =~ /^fig\|\d+\.\d+\.\w+\.\d+$/) {
843                Trace("Gene correspondence error. \"$row->[$col]\" not a gene ID.") if T(Corr => 2);
844              $retVal++;              $retVal++;
845          }          }
846      }      }
847      # Verify the arrow.      # Verify the arrow.
848      unless (exists ARROW_FLIP->{$row->[8]}) {      unless (exists ARROW_FLIP->{$row->[8]}) {
849            Trace("Gene correspondence error. \"$row->[8]\" not an arrow.") if T(Corr => 2);
850          $retVal++;          $retVal++;
851      }      }
852      # Return the error count.      # Return the error count.
# Line 796  Line 869 
869    
870  =item cgi  =item cgi
871    
872  CGI query object containing the parameters from the web service request.  CGI query object containing the parameters from the web service request. The
873    significant parameters are as follows.
874    
875    =over 8
876    
877    =item function
878    
879    Name of the function to run.
880    
881    =item args
882    
883    Parameters for the function.
884    
885    =item encoding
886    
887    Encoding scheme for the function parameters, either C<yaml> (the default) or C<json> (used
888    by the Java interface).
889    
890    =back
891    
892    Certain unusual requests can come in outside of the standard function interface.
893    These are indicated by special parameters that override all the others.
894    
895    =over 8
896    
897    =item pod
898    
899    Display a POD documentation module.
900    
901    =item code
902    
903    Display an example code file.
904    
905    =item file
906    
907    Transfer a file (not implemented).
908    
909    =back
910    
911  =item serverThing  =item serverThing
912    
# Line 847  Line 957 
957          my $sapling;          my $sapling;
958          # Protect from errors.          # Protect from errors.
959          eval {          eval {
960              # Parse the arguments.              # Here we parse the arguments. This is affected by the encoding parameter.
961              $args = YAML::Load($cgi->param('args'));              # The default is YAML.
962                my $encoding = $cgi->param('encoding') || 'yaml';
963                # Get the argument string.
964                my $argString = $cgi->param('args');
965                if ($encoding eq 'yaml') {
966                    # Parse the arguments using YAML.
967                    $args = YAML::Load($argString);
968                } elsif ($encoding eq 'json') {
969                    # Parse the arguments using JSON.
970                    Trace("Incoming string is:\n$argString") if T(3);
971                    $args = JSON::Any->jsonToObj($argString);
972                } else {
973                    Die("Invalid encoding type $encoding.");
974                }
975          };          };
976          # Check to make sure we got everything.          # Check to make sure we got everything.
977          if ($@) {          if ($@) {
# Line 1035  Line 1158 
1158      my ($module) = @_;      my ($module) = @_;
1159      # Start the output page.      # Start the output page.
1160      print CGI::header();      print CGI::header();
1161      print CGI::start_html(-title => 'Documentation Page',      print CGI::start_html(-title => "$module Documentation Page",
1162                            -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });                            -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });
1163      # Protect from errors.      # Protect from errors.
1164      eval {      eval {

Legend:
Removed from v.1.40  
changed lines
  Added in v.1.50

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3