[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.8, Wed Sep 30 15:34:28 2009 UTC revision 1.9, Thu Oct 29 18:26:59 2009 UTC
# Line 8  Line 8 
8      use ERDB;      use ERDB;
9      use TestUtils;      use TestUtils;
10      use Time::HiRes;      use Time::HiRes;
11        use File::Temp;
12      use ErrorDocument;      use ErrorDocument;
13      use CGI;      use CGI;
14        no warnings qw(once);
15    
16  =head1 General Server Helper  =head1 General Server Helper
17    
18  This package provides a method-- I<RunServer>-- that can be called from a CGI  This package provides a method-- I<RunServer>-- that can be called from a CGI
19  script to perform the duties of a FIG server. RunServer is called with three  script to perform the duties of a FIG server. RunServer is called with two
20  parameters: the name of the server package (e.g. C<SAP> for B<SAP.pm>),  parameters: the name of the server package (e.g. C<SAP> for B<SAP.pm>) and
21  the first command-line parameter, and the URL prefix to use for the documentation.  the first command-line parameter. The command-line parameter (if defined) will
22  The command-line parameter (if defined) will be used as the tracing key, and is  be used as the tracing key, and also indicates that the script is being invoked
23  used to indicate that the script is being invoked from the command line rather  from the command line rather than over the web.
 than over the web.  
24    
25  =cut  =cut
26    
27  sub RunServer {  sub RunServer {
28      # Get the parameters.      # Get the parameters.
29      my ($serverName, $key, $docURL) = @_;      my ($serverName, $key) = @_;
30        # Turn off YAML compression, which causes problems with some of our hash keys.
31        $YAML::CompressSeries = 0;
32      # Get the CGI parameters.      # Get the CGI parameters.
33      my $cgi;      my $cgi;
34      if (! defined $key) {      if (! defined $key) {
# Line 37  Line 40 
40              # Loop through the fast CGI requests.              # Loop through the fast CGI requests.
41              require CGI::Fast;              require CGI::Fast;
42              while ($cgi = new CGI::Fast()) {              while ($cgi = new CGI::Fast()) {
43                  RunRequest($cgi, $serverName, $docURL);                  RunRequest($cgi, $serverName);
44              }              }
45          } else {          } else {
46              # Here we have a normal web service (non-Fast).              # Here we have a normal web service (non-Fast).
# Line 53  Line 56 
56                  ETracing($key);                  ETracing($key);
57              }              }
58              # Run this request.              # Run this request.
59              RunRequest($cgi, $serverName, $docURL);              RunRequest($cgi, $serverName);
60          }          }
61      } else {      } else {
62          # We're being invoked from the command line. Use the tracing          # We're being invoked from the command line. Use the tracing
# Line 63  Line 66 
66          # Set up tracing using the specified key.          # Set up tracing using the specified key.
67          ETracing($key);          ETracing($key);
68          # Run this request.          # Run this request.
69          RunRequest($cgi, $serverName, $docURL);          RunRequest($cgi, $serverName);
70      }      }
71  }  }
72    
73    
74    =head2 Server Utility Methods
75    
76    The methods in this section are utilities of general use to the various
77    server modules.
78    
79    =head3 GetIdList
80    
81        my $ids = ServerThing::GetIdList($name => $args);
82    
83    Get a named list of IDs from an argument structure. If the IDs are
84    missing, or are not a list, an error will occur.
85    
86    =over 4
87    
88    =item name
89    
90    Name of the argument structure member that should contain the ID list.
91    
92    =item args
93    
94    Argument structure from which the ID list is to be extracted.
95    
96    =item RETURN
97    
98    Returns a reference to a list of IDs taken from the argument structure.
99    
100    =back
101    
102    =cut
103    
104    sub GetIdList {
105        # Get the parameters.
106        my ($name, $args) = @_;
107        # Try to get the IDs from the argument structure.
108        my $retVal = $args->{$name};
109        # Throw an error if no member was found.
110        Confess("No '$name' parameter found.") if ! defined $retVal;
111        # Get the parameter type. We was a list reference. If it's a scalar, we'll
112        # convert it to a singleton list. If it's anything else, it's an error.
113        my $type = ref $retVal;
114        if (! $type) {
115            $retVal = [$retVal];
116        } elsif ($type ne 'ARRAY') {
117            Confess("The '$name' parameter must be a list.");
118        }
119        # Return the result.
120        return $retVal;
121    }
122    
123    
124    =head3 RunTool
125    
126        ServerThing::RunTool($name => $cmd);
127    
128    Run a command-line tool. A non-zero return value from the tool will cause
129    a fatal error, and the tool's error log will be traced.
130    
131    =over 4
132    
133    =item name
134    
135    Name to give to the tool in the error output.
136    
137    =item cmd
138    
139    Command to use for running the tool. This should be the complete command line.
140    The command should not contain any fancy piping, though it may redirect the
141    standard input and output. The command will be modified by this method to
142    redirect the error output to a temporary file.
143    
144    =back
145    
146    =cut
147    
148    sub RunTool {
149        # Get the parameters.
150        my ($name, $cmd) = @_;
151        # Compute the log file name.
152        my $errorLog = "$FIG_Config::temp/errors$$.log";
153        # Execute the command.
154        Trace("Executing command: $cmd") if T(3);
155        my $res = system("$cmd 2> $errorLog");
156        Trace("Return from $name tool is $res.") if T(3);
157        # Check the result code.
158        if ($res != 0) {
159            # We have an error. If tracing is on, trace it.
160            if (T(1)) {
161                TraceErrorLog($name, $errorLog);
162            }
163            # Delete the error log.
164            unlink $errorLog;
165            # Confess the error.
166            Confess("500 $name command failed with error code $res.");
167        } else {
168            # Everything worked. Trace the error log if necessary.
169            if (T(3) && -s $errorLog) {
170                TraceErrorLog($name, $errorLog);
171            }
172            # Delete the error log if there is one.
173            unlink $errorLog;
174        }
175    }
176    
177    
178    =head2 Internal Utility Methods
179    
180    The methods in this section are used internally by this package.
181    
182  =head3 RunRequest  =head3 RunRequest
183    
184      ServerThing::RunRequest($cgi, $serverName, $docURL);      ServerThing::RunRequest($cgi, $serverName);
185    
186  Run a request from the specified server using the incoming CGI parameter  Run a request from the specified server using the incoming CGI parameter
187  object for the parameters.  object for the parameters.
# Line 85  Line 196 
196    
197  Name of the server to be used for running the request.  Name of the server to be used for running the request.
198    
 =item docURL  
   
 URL to be used for a documentation request.  
   
199  =back  =back
200    
201  =cut  =cut
# Line 97  Line 204 
204      # Get the parameters.      # Get the parameters.
205      my ($cgi, $serverName, $docURL) = @_;      my ($cgi, $serverName, $docURL) = @_;
206      Trace("Running $serverName server request.") if T(3);      Trace("Running $serverName server request.") if T(3);
207      # Is this a documentation request?      # Determine the request type.
208      my $module = $cgi->param('pod');      if ($cgi->param('pod')) {
     if ($module) {  
209          # Here we have a documentation request. In this case, we produce POD HTML.          # Here we have a documentation request. In this case, we produce POD HTML.
210          # Start the output page.          ProducePod($cgi->param('pod'));
211          print CGI::header();      } elsif ($cgi->param('file')) {
212          print CGI::start_html(-title => 'Documentation Page',          # Here we have a file request. Process according to the type.
213                                -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });          my $type = $cgi->param('file');
214          # Protect from errors.          if ($type eq 'open') {
215          eval {              OpenFile($cgi->param('name'));
216              # We'll format the HTML text in here.          } elsif ($type eq 'create') {
217              require DocUtils;              CreateFile();
218              my $html = DocUtils::ShowPod($module, $docURL);          } elsif ($type eq 'read') {
219              # Output the POD HTML.              ReadChunk($cgi->param('name'), $cgi->param('location'), $cgi->param('size'));
220              print $html;          } elsif ($type eq 'write') {
221          };              WriteChunk($cgi->param('name'), $cgi->param('data'));
222          # Process any error.          } else {
223          if ($@) {              Die("Invalid file function \"$type\".");
             print CGI::blockquote({ class => 'error' }, $@);  
224          }          }
         # Close off the page.  
         print CGI::end_html();  
225      } else {      } else {
226          # Here we have a function request. Get the function name.          # The default is a function request. Get the function name.
227          my $function = $cgi->param('function') || "";          my $function = $cgi->param('function') || "";
228          Trace("Server function is $function.") if T(3);          Trace("Server function is $function.") if T(3);
229          # Insure the function name is valid.          # Insure the function name is valid.
# Line 182  Line 285 
285      }      }
286  }  }
287    
288    =head3 CreateFile
289    
290  =head2 Utility Methods      ServerThing::CreateFile();
291    
292  The methods in this section are utilities of general use to the various  Create a new, empty temporary file and send its name back to the client.
 server modules.  
293    
294  =head3 GetIdList  =cut
295    
296      my $ids = ServerThing::GetIdList($name => $args);  sub CreateFile {
297        ##TODO: Code
298    }
299    
300  Get a named list of IDs from an argument structure. If the IDs are  =head3 OpenFile
301  missing, or are not a list, an error will occur.  
302        ServerThing::OpenFile($name);
303    
304    Send the length of the named file back to the client.
305    
306  =over 4  =over 4
307    
308  =item name  =item name
309    
310  Name of the argument structure member that should contain the ID list.  ##TODO: name description
311    
312  =item args  =back
313    
314  Argument structure from which the ID list is to be extracted.  =cut
315    
316  =item RETURN  sub OpenFile {
317        # Get the parameters.
318        my ($name) = @_;
319        ##TODO: Code
320    }
321    
322  Returns a reference to a list of IDs taken from the argument structure.  =head3 ReadChunk
323    
324        ServerThing::ReadChunk($name, $location, $size);
325    
326    Read the indicated number of bytes from the specified location of the
327    named file and send them back to the client.
328    
329    =over 4
330    
331    =item name
332    
333    ##TODO: name description
334    
335    =item location
336    
337    ##TODO: location description
338    
339    =item size
340    
341    ##TODO: size description
342    
343  =back  =back
344    
345  =cut  =cut
346    
347  sub GetIdList {  sub ReadChunk {
348      # Get the parameters.      # Get the parameters.
349      my ($name, $args) = @_;      my ($name, $location, $size) = @_;
350      # Try to get the IDs from the argument structure.      ##TODO: Code
     my $retVal = $args->{$name};  
     # Throw an error if no member was found.  
     Confess("No '$name' parameter found.") if ! defined $retVal;  
     # Get the parameter type. We was a list reference. If it's a scalar, we'll  
     # convert it to a singleton list. If it's anything else, it's an error.  
     my $type = ref $retVal;  
     if (! $type) {  
         $retVal = [$retVal];  
     } elsif ($type ne 'ARRAY') {  
         Confess("The '$name' parameter must be a list.");  
     }  
     # Return the result.  
     return $retVal;  
351  }  }
352    
353    =head3 WriteChunk
354    
355  =head3 RunTool      ServerThing::WriteChunk($name, $data);
356    
357      ServerThing::RunTool($name => $cmd);  Write the specified data to the named file.
   
 Run a command-line tool. A non-zero return value from the tool will cause  
 a fatal error, and the tool's error log will be traced.  
358    
359  =over 4  =over 4
360    
361  =item name  =item name
362    
363  Name to give to the tool in the error output.  ##TODO: name description
364    
365  =item cmd  =item data
366    
367  Command to use for running the tool. This should be the complete command line.  ##TODO: data description
 The command should not contain any fancy piping, though it may redirect the  
 standard input and output. The command will be modified by this method to  
 redirect the error output to a temporary file.  
368    
369  =back  =back
370    
371  =cut  =cut
372    
373  sub RunTool {  sub WriteChunk {
374      # Get the parameters.      # Get the parameters.
375      my ($name, $cmd) = @_;      my ($name, $data) = @_;
376      # Compute the log file name.      ##TODO: Code
     my $errorLog = "$FIG_Config::temp/errors$$.log";  
     # Execute the command.  
     Trace("Executing command: $cmd") if T(3);  
     my $res = system("$cmd 2> $errorLog");  
     Trace("Return from $name tool is $res.") if T(3);  
     # Check the result code.  
     if ($res != 0) {  
         # We have an error. If tracing is on, trace it.  
         if (T(1)) {  
             TraceErrorLog($name, $errorLog);  
377          }          }
378          # Delete the error log.  
379          unlink $errorLog;  
380          # Confess the error.  =head3 ProducePod
381          Confess("500 $name command failed with error code $res.");  
382      } else {      ServerThing::ProducePod($module);
383          # Everything worked. Trace the error log if necessary.  
384          if (T(3) && -s $errorLog) {  Output the POD documentation for the specified module.
385              TraceErrorLog($name, $errorLog);  
386          }  =over 4
387          # Delete the error log if there is one.  
388          unlink $errorLog;  =item module
389    
390    Name of the module whose POD document is to be displayed.
391    
392    =back
393    
394    =cut
395    
396    sub ProducePod {
397        # Get the parameters.
398        my ($module) = @_;
399        # Start the output page.
400        print CGI::header();
401        print CGI::start_html(-title => 'Documentation Page',
402                              -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });
403        # Protect from errors.
404        eval {
405            # We'll format the HTML text in here.
406            require DocUtils;
407            my $html = DocUtils::ShowPod($module, "http://servers.nmpdr.org/sapling/servers.cgi?pod=");
408            # Output the POD HTML.
409            print $html;
410        };
411        # Process any error.
412        if ($@) {
413            print CGI::blockquote({ class => 'error' }, $@);
414      }      }
415        # Close off the page.
416        print CGI::end_html();
417    
418  }  }
419    
420  =head3 TraceErrorLog  =head3 TraceErrorLog

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3