[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.61, Wed Jan 26 15:32:08 2011 UTC revision 1.68, Tue Mar 15 19:06:08 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.
# Line 1031  Line 1035 
1035    
1036  =head3 RunRequest  =head3 RunRequest
1037    
1038      ServerThing::RunRequest($cgi, $serverName);      ServerThing::RunRequest($cgi, $serverThing, $docURL);
1039    
1040  Run a request from the specified server using the incoming CGI parameter  Run a request from the specified server using the incoming CGI parameter
1041  object for the parameters.  object for the parameters.
# Line 1083  Line 1087 
1087    
1088  Server object against which to run the request.  Server object against which to run the request.
1089    
1090    =item docURL
1091    
1092    URL to use for POD documentation requests.
1093    
1094  =back  =back
1095    
1096  =cut  =cut
# Line 1090  Line 1098 
1098  sub RunRequest {  sub RunRequest {
1099      # Get the parameters.      # Get the parameters.
1100      my ($cgi, $serverThing, $docURL) = @_;      my ($cgi, $serverThing, $docURL) = @_;
1101        # Make the CGI object available to the server.
1102        $serverThing->{cgi} = $cgi;
1103      # Determine the request type.      # Determine the request type.
1104      my $module = $cgi->param('pod');      my $module = $cgi->param('pod');
1105      if ($module) {      if ($module) {
# Line 1124  Line 1134 
1134          my $function = $cgi->param('function') || "";          my $function = $cgi->param('function') || "";
1135          Trace("Server function for task $$ is $function.") if T(3);          Trace("Server function for task $$ is $function.") if T(3);
1136          # Insure the function name is valid.          # Insure the function name is valid.
1137          Die("Invalid function name.")          if ($function ne "methods" && exists $serverThing->{methods} && ! $serverThing->{methods}{$function}) {
1138              if $function =~ /\W/;              SendError("Invalid function name.", "$function not found.")
1139            } else {
1140          # Determing the encoding scheme. The default is YAML.          # Determing the encoding scheme. The default is YAML.
1141          my $encoding = $cgi->param('encoding') || 'yaml';          my $encoding = $cgi->param('encoding') || 'yaml';
1142          # Optional callback for json encoded documents          # Optional callback for json encoded documents
# Line 1180  Line 1191 
1191                      print $cgi->header(-type => 'text/javascript');                      print $cgi->header(-type => 'text/javascript');
1192                  }                  }
1193                  # The nature of the output depends on the encoding type.                  # The nature of the output depends on the encoding type.
1194                        eval {
1195                  my $string;                  my $string;
1196                  if ($encoding eq 'yaml') {                  if ($encoding eq 'yaml') {
1197                      $string = YAML::Dump($document);                      $string = YAML::Dump($document);
# Line 1190  Line 1202 
1202                  }                  }
1203                  print $string;                  print $string;
1204                  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);
1205                        };
1206                        if ($@) {
1207                            SendError($@, "Error encoding result.");
1208                            Trace("Error encoding result: $@") if T(0);
1209                        }
1210              }              }
1211          }          }
1212          # Stop the timer.          # Stop the timer.
# Line 1197  Line 1214 
1214          Trace("Function $function executed in $duration seconds by task $$.") if T(2);          Trace("Function $function executed in $duration seconds by task $$.") if T(2);
1215      }      }
1216  }  }
1217    }
1218    
1219  =head3 CreateFile  =head3 CreateFile
1220    
# Line 1445  Line 1463 
1463  }  }
1464    
1465    
1466    =head3 Log
1467    
1468        Log($msg);
1469    
1470    Write a message to the log. This is a temporary hack until we can figure out how to get
1471    normal tracing and error logging working.
1472    
1473    =over 4
1474    
1475    =item msg
1476    
1477    Message to write. It will be appended to the C<servers.log> file in the FIG temporary directory.
1478    
1479    =back
1480    
1481    =cut
1482    
1483    sub Log {
1484        # Get the parameters.
1485        my ($msg) = @_;
1486        # Open the log file for appending.
1487        open(my $oh, ">>$FIG_Config::temp/servers.log") || Confess("Log error: $!");
1488        print $oh "$msg\n";
1489        close $oh;
1490    }
1491    
1492  1;  1;

Legend:
Removed from v.1.61  
changed lines
  Added in v.1.68

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3