[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.42, Fri Mar 19 00:15:05 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 514  Line 514 
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 (MustFlipGenomeIDs($genome1, $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 695  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 716  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.
# Line 731  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 767  Line 798 
798      $row->[8] = ARROW_FLIP->{$row->[8]};      $row->[8] = ARROW_FLIP->{$row->[8]};
799      # Flip the pairs.      # Flip the pairs.
800      my @elements = split /,/, $row->[3];      my @elements = split /,/, $row->[3];
801      $row->[3] = join(",", map { reverse split /:/, $_ } @elements);      $row->[3] = join(",", map { join(":", reverse split /:/, $_) } @elements);
802  }  }
803    
804  =head3 ValidateGeneCorrespondenceRow  =head3 ValidateGeneCorrespondenceRow
# Line 801  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 834  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 885  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 1073  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.42  
changed lines
  Added in v.1.49

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3