[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.62, Wed Feb 9 17:56:09 2011 UTC revision 1.73, Thu Mar 31 20:03:07 2011 UTC
# Line 55  Line 55 
55          if ($@) {          if ($@) {
56              SendError($@, "Could not start server.");              SendError($@, "Could not start server.");
57          } else {          } else {
58              # No error, so now we can process the request.              # No error, so now we can process the request. First, get the method list.
59                my $methods = $serverThing->methods();
60                # Store it in the object so we can use it to validate methods.
61                my %methodHash = map { $_ => 1 } @$methods;
62                $serverThing->{methods} = \%methodHash;
63              my $cgi;              my $cgi;
64              if (! defined $key) {              if (! defined $key) {
65                  # No tracing key, so presume we're a web service. Check for Fast CGI.                  # No tracing key, so presume we're a web service. Check for Fast CGI.
66                  if ($ENV{REQUEST_METHOD} eq '') {                  if ($ENV{REQUEST_METHOD} eq '') {
67                      # Count the number of requests.                      # Count the number of requests.
68                      my $requests = 0;                      my $requests = 0;
69                      Trace("Starting Fast CGI loop.") if T(3);                      # warn "Starting fast CGI loop.\n"; ##HACK Trace("Starting Fast CGI loop.") if T(3);
70                      # Loop through the fast CGI requests. If we have request throttling,                      # Loop through the fast CGI requests. If we have request throttling,
71                      # we exit after a maximum number of requests has been exceeded.                      # we exit after a maximum number of requests has been exceeded.
72                      require CGI::Fast;                      require CGI::Fast;
73                        open(SERVER_STDERR, ">&", *STDERR);
74                      while ((MAX_REQUESTS == 0 || ++$requests < MAX_REQUESTS) &&                      while ((MAX_REQUESTS == 0 || ++$requests < MAX_REQUESTS) &&
75                             ($cgi = new CGI::Fast())) {                             ($cgi = new CGI::Fast())) {
76                            #
77                            # Remap STDERR. Inside here, our STDERR is a tie to a FCGI::Stream
78                            # so we need to save it to keep FCGI happy.
79                            #
80                            *SAVED_STDERR = *STDERR;
81                            *STDERR = *SERVER_STDERR;
82                            my $function = $cgi->param('function') || "<non-functional>"; # (useful if we do tracing in here)
83                            # warn "Function request is $function in task $$.\n"; ##HACK
84                          RunRequest($cgi, $serverThing);                          RunRequest($cgi, $serverThing);
85                          Trace("Request $requests complete in task $$.") if T(3);                          # warn "$requests requests complete in fast CGI task $$.\n"; ##HACK Trace("Request $requests complete in task $$.") if T(3);
86                            *STDERR = *SAVED_STDERR;
87                      }                      }
88                      Trace("Terminating FastCGI task $$ after $requests requests.") if T(2);                      # warn "Terminating FastCGI task $$ after $requests requests.\n"; ##HACK Trace("Terminating FastCGI task $$ after $requests requests.") if T(2);
89                        close(SERVER_STDERR);
90                  } else {                  } else {
91                      # Here we have a normal web service (non-Fast).                      # Here we have a normal web service (non-Fast).
92                      my $cgi = CGI->new();                      my $cgi = CGI->new();
# Line 520  Line 535 
535  Bit score for the match. Divide by the length of the longer PEG to get  Bit score for the match. Divide by the length of the longer PEG to get
536  what we often refer to as a "normalized bit score".  what we often refer to as a "normalized bit score".
537    
538    =item 18 (optional)
539    
540    Clear-correspondence indicator. If present, will be C<1> if the correspondence is a
541    clear bidirectional best hit (no similar candidates) and C<0> otherwise.
542    
543  =back  =back
544    
545  In the actual files, there will also be reverse correspondences indicated by a  In the actual files, there will also be reverse correspondences indicated by a
# Line 1130  Line 1150 
1150          my $function = $cgi->param('function') || "";          my $function = $cgi->param('function') || "";
1151          Trace("Server function for task $$ is $function.") if T(3);          Trace("Server function for task $$ is $function.") if T(3);
1152          # Insure the function name is valid.          # Insure the function name is valid.
1153          Die("Invalid function name.")          if ($function ne "methods" && exists $serverThing->{methods} && ! $serverThing->{methods}{$function}) {
1154              if $function =~ /\W/;              SendError("Invalid function name.", "$function not found.")
1155            } else {
1156          # Determing the encoding scheme. The default is YAML.          # Determing the encoding scheme. The default is YAML.
1157          my $encoding = $cgi->param('encoding') || 'yaml';          my $encoding = $cgi->param('encoding') || 'yaml';
1158          # Optional callback for json encoded documents          # Optional callback for json encoded documents
# Line 1186  Line 1207 
1207                      print $cgi->header(-type => 'text/javascript');                      print $cgi->header(-type => 'text/javascript');
1208                  }                  }
1209                  # The nature of the output depends on the encoding type.                  # The nature of the output depends on the encoding type.
1210                        eval {
1211                  my $string;                  my $string;
1212                  if ($encoding eq 'yaml') {                  if ($encoding eq 'yaml') {
1213                      $string = YAML::Dump($document);                      $string = YAML::Dump($document);
# Line 1196  Line 1218 
1218                  }                  }
1219                  print $string;                  print $string;
1220                  MemTrace(length($string) . " bytes returned from $function by task $$.") if T(Memory => 3);                  MemTrace(length($string) . " bytes returned from $function by task $$.") if T(Memory => 3);
1221                        };
1222                        if ($@) {
1223                            SendError($@, "Error encoding result.");
1224                            Trace("Error encoding result: $@") if T(0);
1225                        }
1226              }              }
1227          }          }
1228          # Stop the timer.          # Stop the timer.
# Line 1203  Line 1230 
1230          Trace("Function $function executed in $duration seconds by task $$.") if T(2);          Trace("Function $function executed in $duration seconds by task $$.") if T(2);
1231      }      }
1232  }  }
1233    }
1234    
1235  =head3 CreateFile  =head3 CreateFile
1236    
# Line 1370  Line 1398 
1398      eval {      eval {
1399          # We'll format the HTML text in here.          # We'll format the HTML text in here.
1400          require DocUtils;          require DocUtils;
1401          my $html = DocUtils::ShowPod($module, "http://servers.nmpdr.org/sapling/server.cgi?pod=");          my $html = DocUtils::ShowPod($module, "http://pubseed.theseed.org/sapling/server.cgi?pod=");
1402          # Output the POD HTML.          # Output the POD HTML.
1403          print $html;          print $html;
1404      };      };
# Line 1451  Line 1479 
1479  }  }
1480    
1481    
1482    =head3 Log
1483    
1484        Log($msg);
1485    
1486    Write a message to the log. This is a temporary hack until we can figure out how to get
1487    normal tracing and error logging working.
1488    
1489    =over 4
1490    
1491    =item msg
1492    
1493    Message to write. It will be appended to the C<servers.log> file in the FIG temporary directory.
1494    
1495    =back
1496    
1497    =cut
1498    
1499    sub Log {
1500        # Get the parameters.
1501        my ($msg) = @_;
1502        # Open the log file for appending.
1503        open(my $oh, ">>$FIG_Config::temp/servers.log") || Confess("Log error: $!");
1504        print $oh "$msg\n";
1505        close $oh;
1506    }
1507    
1508  1;  1;

Legend:
Removed from v.1.62  
changed lines
  Added in v.1.73

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3