[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.60, Tue Jan 25 22:44:43 2011 UTC revision 1.71, Thu Mar 17 20:30:01 2011 UTC
# Line 42  Line 42 
42      eval {      eval {
43          my $output = $serverName;          my $output = $serverName;
44          $output =~ s/::/\//;          $output =~ s/::/\//;
45          require "$serverName.pm";          require "$output.pm";
46      };      };
47      # If we have an error, create an error document.      # If we have an error, create an error document.
48      if ($@) {      if ($@) {
# 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                            my $function = $cgi->param('function') || "<non-functional>"; #HACK
82                            # warn "Function request is $function in task $$.\n"; ##HACK
83                          RunRequest($cgi, $serverThing);                          RunRequest($cgi, $serverThing);
84                          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);
85                            *STDERR = *SAVED_STDERR;
86                      }                      }
87                      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);
88                        close(SERVER_STDERR);
89                  } else {                  } else {
90                      # Here we have a normal web service (non-Fast).                      # Here we have a normal web service (non-Fast).
91                      my $cgi = CGI->new();                      my $cgi = CGI->new();
# Line 1031  Line 1045 
1045    
1046  =head3 RunRequest  =head3 RunRequest
1047    
1048      ServerThing::RunRequest($cgi, $serverName);      ServerThing::RunRequest($cgi, $serverThing, $docURL);
1049    
1050  Run a request from the specified server using the incoming CGI parameter  Run a request from the specified server using the incoming CGI parameter
1051  object for the parameters.  object for the parameters.
# Line 1083  Line 1097 
1097    
1098  Server object against which to run the request.  Server object against which to run the request.
1099    
1100    =item docURL
1101    
1102    URL to use for POD documentation requests.
1103    
1104  =back  =back
1105    
1106  =cut  =cut
# Line 1090  Line 1108 
1108  sub RunRequest {  sub RunRequest {
1109      # Get the parameters.      # Get the parameters.
1110      my ($cgi, $serverThing, $docURL) = @_;      my ($cgi, $serverThing, $docURL) = @_;
1111        # Make the CGI object available to the server.
1112        $serverThing->{cgi} = $cgi;
1113      # Determine the request type.      # Determine the request type.
1114      my $module = $cgi->param('pod');      my $module = $cgi->param('pod');
1115      if ($module) {      if ($module) {
# Line 1124  Line 1144 
1144          my $function = $cgi->param('function') || "";          my $function = $cgi->param('function') || "";
1145          Trace("Server function for task $$ is $function.") if T(3);          Trace("Server function for task $$ is $function.") if T(3);
1146          # Insure the function name is valid.          # Insure the function name is valid.
1147          Die("Invalid function name.")          if ($function ne "methods" && exists $serverThing->{methods} && ! $serverThing->{methods}{$function}) {
1148              if $function =~ /\W/;              SendError("Invalid function name.", "$function not found.")
1149            } else {
1150          # Determing the encoding scheme. The default is YAML.          # Determing the encoding scheme. The default is YAML.
1151          my $encoding = $cgi->param('encoding') || 'yaml';          my $encoding = $cgi->param('encoding') || 'yaml';
1152          # Optional callback for json encoded documents          # Optional callback for json encoded documents
# Line 1180  Line 1201 
1201                      print $cgi->header(-type => 'text/javascript');                      print $cgi->header(-type => 'text/javascript');
1202                  }                  }
1203                  # The nature of the output depends on the encoding type.                  # The nature of the output depends on the encoding type.
1204                        eval {
1205                  my $string;                  my $string;
1206                  if ($encoding eq 'yaml') {                  if ($encoding eq 'yaml') {
1207                      $string = YAML::Dump($document);                      $string = YAML::Dump($document);
# Line 1190  Line 1212 
1212                  }                  }
1213                  print $string;                  print $string;
1214                  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);
1215                        };
1216                        if ($@) {
1217                            SendError($@, "Error encoding result.");
1218                            Trace("Error encoding result: $@") if T(0);
1219                        }
1220              }              }
1221          }          }
1222          # Stop the timer.          # Stop the timer.
# Line 1197  Line 1224 
1224          Trace("Function $function executed in $duration seconds by task $$.") if T(2);          Trace("Function $function executed in $duration seconds by task $$.") if T(2);
1225      }      }
1226  }  }
1227    }
1228    
1229  =head3 CreateFile  =head3 CreateFile
1230    
# Line 1445  Line 1473 
1473  }  }
1474    
1475    
1476    =head3 Log
1477    
1478        Log($msg);
1479    
1480    Write a message to the log. This is a temporary hack until we can figure out how to get
1481    normal tracing and error logging working.
1482    
1483    =over 4
1484    
1485    =item msg
1486    
1487    Message to write. It will be appended to the C<servers.log> file in the FIG temporary directory.
1488    
1489    =back
1490    
1491    =cut
1492    
1493    sub Log {
1494        # Get the parameters.
1495        my ($msg) = @_;
1496        # Open the log file for appending.
1497        open(my $oh, ">>$FIG_Config::temp/servers.log") || Confess("Log error: $!");
1498        print $oh "$msg\n";
1499        close $oh;
1500    }
1501    
1502  1;  1;

Legend:
Removed from v.1.60  
changed lines
  Added in v.1.71

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3