[Bio] / FigKernelPackages / ServerThing.pm Repository:
ViewVC logotype

Annotation of /FigKernelPackages/ServerThing.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.52 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package ServerThing;
4 :    
5 :     use strict;
6 :     use Tracer;
7 :     use YAML;
8 : parrello 1.50 use JSON::Any;
9 : parrello 1.1 use ERDB;
10 :     use TestUtils;
11 :     use Time::HiRes;
12 : parrello 1.9 use File::Temp;
13 : parrello 1.10 use ErrorMessage;
14 : parrello 1.1 use CGI;
15 : parrello 1.9 no warnings qw(once);
16 : parrello 1.1
17 : parrello 1.11 # Maximum number of requests to run per invocation.
18 : olson 1.48 use constant MAX_REQUESTS => 50;
19 : parrello 1.11
20 : parrello 1.1 =head1 General Server Helper
21 :    
22 :     This package provides a method-- I<RunServer>-- that can be called from a CGI
23 : parrello 1.9 script to perform the duties of a FIG server. RunServer is called with two
24 :     parameters: the name of the server package (e.g. C<SAP> for B<SAP.pm>) and
25 :     the first command-line parameter. The command-line parameter (if defined) will
26 :     be used as the tracing key, and also indicates that the script is being invoked
27 :     from the command line rather than over the web.
28 : parrello 1.1
29 :     =cut
30 :    
31 :     sub RunServer {
32 :     # Get the parameters.
33 : parrello 1.9 my ($serverName, $key) = @_;
34 : parrello 1.25 # Set up tracing. We never do CGI tracing here; the only question is whether
35 :     # or not the caller passed in a tracing key. If he didn't, we use the server
36 :     # name.
37 : parrello 1.32 ETracing($key || $serverName, destType => 'APPEND', level => '0 ServerThing');
38 : parrello 1.9 # Turn off YAML compression, which causes problems with some of our hash keys.
39 :     $YAML::CompressSeries = 0;
40 : parrello 1.13 # Create the server object.
41 : parrello 1.15 Trace("Requiring $serverName for task $$.") if T(3);
42 : parrello 1.13 eval {
43 :     require "$serverName.pm";
44 :     };
45 :     # If we have an error, create an error document.
46 :     if ($@) {
47 :     SendError($@, "Could not load server module.");
48 :     } else {
49 :     # Having successfully loaded the server code, we create the object.
50 :     my $serverThing = eval("$serverName" . '->new()');
51 : parrello 1.15 Trace("$serverName object created for task $$.") if T(2);
52 : parrello 1.13 # If we have an error, create an error document.
53 :     if ($@) {
54 :     SendError($@, "Could not start server.");
55 : parrello 1.3 } else {
56 : parrello 1.13 # No error, so now we can process the request.
57 :     my $cgi;
58 :     if (! defined $key) {
59 :     # No tracing key, so presume we're a web service. Check for Fast CGI.
60 :     if ($ENV{REQUEST_METHOD} eq '') {
61 :     # Count the number of requests.
62 :     my $requests = 0;
63 : parrello 1.24 Trace("Starting Fast CGI loop.") if T(3);
64 : parrello 1.13 # Loop through the fast CGI requests. If we have request throttling,
65 :     # we exit after a maximum number of requests has been exceeded.
66 :     require CGI::Fast;
67 : parrello 1.23 while ((MAX_REQUESTS == 0 || ++$requests < MAX_REQUESTS) &&
68 :     ($cgi = new CGI::Fast())) {
69 : parrello 1.13 RunRequest($cgi, $serverThing);
70 : parrello 1.16 Trace("Request $requests complete in task $$.") if T(3);
71 : parrello 1.13 }
72 : parrello 1.15 Trace("Terminating FastCGI task $$ after $requests requests.") if T(2);
73 : parrello 1.13 } else {
74 :     # Here we have a normal web service (non-Fast).
75 :     my $cgi = CGI->new();
76 :     # Check for a source parameter. This gets used as the tracing key.
77 :     $key = $cgi->param('source');
78 :     # Run this request.
79 :     RunRequest($cgi, $serverThing);
80 :     }
81 : parrello 1.6 } else {
82 : parrello 1.13 # We're being invoked from the command line. Use the tracing
83 :     # key to find the parm file and create the CGI object from that.
84 :     my $ih = Open(undef, "<$FIG_Config::temp/$key.parms");
85 :     $cgi = CGI->new($ih);
86 :     # Run this request.
87 :     RunRequest($cgi, $serverThing);
88 : parrello 1.6 }
89 : parrello 1.3 }
90 : parrello 1.1 }
91 : parrello 1.6 }
92 :    
93 :    
94 : parrello 1.9 =head2 Server Utility Methods
95 :    
96 :     The methods in this section are utilities of general use to the various
97 :     server modules.
98 :    
99 : parrello 1.21 =head3 AddSubsystemFilter
100 :    
101 : parrello 1.52 ServerThing::AddSubsystemFilter(\$filter, $args, $roles);
102 : parrello 1.21
103 :     Add subsystem filtering information to the specified query filter clause
104 :     based on data in the argument hash. The argument hash will be checked for
105 : parrello 1.52 the C<-usable> parameter, which includes or excludes unusuable subsystems,
106 : parrello 1.22 the C<-exclude> parameter, which lists types of subsystems that should be
107 : parrello 1.52 excluded, and the C<-aux> parameter, which filters on auxiliary roles.
108 : parrello 1.21
109 :     =over 4
110 :    
111 :     =item filter
112 :    
113 :     Reference to the current filter string. If additional filtering is required,
114 :     this string will be updated.
115 :    
116 :     =item args
117 :    
118 :     Reference to the parameter hash for the current server call. This hash will
119 : parrello 1.22 be examined for the C<-usable> and C<-exclude> parameters.
120 : parrello 1.21
121 : parrello 1.52 =item roles
122 :    
123 :     If TRUE, role filtering will be applied. In this case, the default action
124 :     is to exclude auxiliary roles unless C<-aux> is TRUE.
125 :    
126 : parrello 1.21 =back
127 :    
128 :     =cut
129 :    
130 :     use constant SS_TYPE_EXCLUDE_ITEMS => { 'cluster-based' => 1,
131 :     experimental => 1,
132 :     private => 1 };
133 :    
134 :     sub AddSubsystemFilter {
135 :     # Get the parameters.
136 : parrello 1.52 my ($filter, $args, $roles) = @_;
137 : parrello 1.21 # We'll put the new filter stuff in here.
138 :     my @newFilters;
139 :     # Unless unusable subsystems are desired, we must add a clause to the filter.
140 : parrello 1.22 # The default is that only usable subsystems are included.
141 :     my $usable = 1;
142 :     # This default can be overridden by the "-usable" parameter.
143 :     if (exists $args->{-usable}) {
144 :     $usable = $args->{-usable};
145 :     }
146 :     # If we're restricting to usable subsystems, add a filter to that effect.
147 :     if ($usable) {
148 : parrello 1.21 push @newFilters, "Subsystem(usable) = 1";
149 :     }
150 :     # Check for exclusion filters.
151 :     my $exclusions = ServerThing::GetIdList(-exclude => $args, 1);
152 :     for my $exclusion (@$exclusions) {
153 :     if (! SS_TYPE_EXCLUDE_ITEMS->{$exclusion}) {
154 :     Confess("Invalid exclusion type \"$exclusion\".");
155 :     } else {
156 :     # Here we have to exclude subsystems of the specified type.
157 :     push @newFilters, "Subsystem($exclusion) = 0";
158 :     }
159 :     }
160 : parrello 1.52 # Check for role filtering.
161 :     if ($roles) {
162 :     # Here, we filter out auxiliary roles unless the user requests
163 :     # them.
164 :     if (! $args->{-aux}) {
165 :     push @newFilters, "Includes(auxiliary) = 0"
166 :     }
167 :     }
168 : parrello 1.21 # Do we need to update the incoming filter?
169 :     if (@newFilters) {
170 :     # Yes. If the incoming filter is nonempty, push it onto the list
171 :     # so it gets included in the result.
172 :     if ($$filter) {
173 :     push @newFilters, $$filter;
174 :     }
175 :     # Put all the filters together to form the new filter.
176 :     $$filter = join(" AND ", @newFilters);
177 : parrello 1.26 Trace("Subsystem filter is $$filter.") if T(ServerUtilities => 3);
178 : parrello 1.21 }
179 :     }
180 :    
181 :    
182 :    
183 : parrello 1.9 =head3 GetIdList
184 :    
185 : parrello 1.19 my $ids = ServerThing::GetIdList($name => $args, $optional);
186 : parrello 1.9
187 :     Get a named list of IDs from an argument structure. If the IDs are
188 :     missing, or are not a list, an error will occur.
189 :    
190 :     =over 4
191 :    
192 :     =item name
193 :    
194 :     Name of the argument structure member that should contain the ID list.
195 :    
196 :     =item args
197 :    
198 :     Argument structure from which the ID list is to be extracted.
199 :    
200 : parrello 1.19 =item optional (optional)
201 :    
202 :     If TRUE, then a missing value will not generate an error. Instead, an empty list
203 :     will be returned. The default is FALSE.
204 :    
205 : parrello 1.9 =item RETURN
206 :    
207 :     Returns a reference to a list of IDs taken from the argument structure.
208 :    
209 :     =back
210 :    
211 :     =cut
212 :    
213 :     sub GetIdList {
214 :     # Get the parameters.
215 : parrello 1.19 my ($name, $args, $optional) = @_;
216 : parrello 1.35 # Declare the return variable.
217 :     my $retVal;
218 : parrello 1.32 # Check the argument format.
219 : parrello 1.35 if (! defined $args && $optional) {
220 :     # Here there are no parameters, but the arguments are optional so it's
221 :     # okay.
222 :     $retVal = [];
223 :     } elsif (ref $args ne 'HASH') {
224 :     # Here we have an invalid parameter structure.
225 : parrello 1.32 Confess("No '$name' parameter present.");
226 : parrello 1.35 } else {
227 :     # Here we have a hash with potential parameters in it. Try to get the
228 :     # IDs from the argument structure.
229 :     $retVal = $args->{$name};
230 :     # Was a member found?
231 :     if (! defined $retVal) {
232 :     # No. If we're optional, return an empty list; otherwise throw an error.
233 :     if ($optional) {
234 :     $retVal = [];
235 :     } else {
236 :     Confess("No '$name' parameter found.");
237 :     }
238 : parrello 1.19 } else {
239 : parrello 1.35 # Here we found something. Get the parameter type. We want a list reference.
240 :     # If it's a scalar, we'll convert it to a singleton list. If it's anything
241 :     # else, it's an error.
242 :     my $type = ref $retVal;
243 :     if (! $type) {
244 :     $retVal = [$retVal];
245 :     } elsif ($type ne 'ARRAY') {
246 :     Confess("The '$name' parameter must be a list.");
247 :     }
248 : parrello 1.19 }
249 : parrello 1.9 }
250 :     # Return the result.
251 :     return $retVal;
252 :     }
253 :    
254 :    
255 :     =head3 RunTool
256 :    
257 :     ServerThing::RunTool($name => $cmd);
258 :    
259 :     Run a command-line tool. A non-zero return value from the tool will cause
260 :     a fatal error, and the tool's error log will be traced.
261 :    
262 :     =over 4
263 :    
264 :     =item name
265 :    
266 :     Name to give to the tool in the error output.
267 :    
268 :     =item cmd
269 :    
270 :     Command to use for running the tool. This should be the complete command line.
271 :     The command should not contain any fancy piping, though it may redirect the
272 :     standard input and output. The command will be modified by this method to
273 :     redirect the error output to a temporary file.
274 :    
275 :     =back
276 :    
277 :     =cut
278 :    
279 :     sub RunTool {
280 :     # Get the parameters.
281 :     my ($name, $cmd) = @_;
282 :     # Compute the log file name.
283 :     my $errorLog = "$FIG_Config::temp/errors$$.log";
284 :     # Execute the command.
285 : parrello 1.26 Trace("Executing command: $cmd") if T(ServerUtilities => 3);
286 : parrello 1.9 my $res = system("$cmd 2> $errorLog");
287 : parrello 1.26 Trace("Return from $name tool is $res.") if T(ServerUtilities => 3);
288 : parrello 1.9 # Check the result code.
289 :     if ($res != 0) {
290 :     # We have an error. If tracing is on, trace it.
291 : parrello 1.26 if (T(ServerUtilities => 1)) {
292 : parrello 1.9 TraceErrorLog($name, $errorLog);
293 :     }
294 :     # Delete the error log.
295 :     unlink $errorLog;
296 :     # Confess the error.
297 : parrello 1.10 Confess("$name command failed with error code $res.");
298 : parrello 1.9 } else {
299 :     # Everything worked. Trace the error log if necessary.
300 : parrello 1.26 if (T(ServerUtilities => 3) && -s $errorLog) {
301 : parrello 1.9 TraceErrorLog($name, $errorLog);
302 :     }
303 :     # Delete the error log if there is one.
304 :     unlink $errorLog;
305 :     }
306 :     }
307 :    
308 : parrello 1.36
309 : parrello 1.37 =head2 Gene Correspondence File Methods
310 : parrello 1.36
311 : parrello 1.37 These methods relate to gene correspondence files, which are generated by the
312 :     L<svr_corresponding_genes.pl> script. Correspondence files are cached in the
313 :     organism cache (I<$FIG_Config::orgCache>) directory. Eventually they will be
314 :     copied into the organism directories themselves. At that point, the code below
315 :     will be modified to check the organism directories first and use the cache
316 :     directory if no file is found there.
317 :    
318 :     A gene correspondence file contains correspondences from a source genome to a
319 :     target genome. Most such correspondences are bidirectional best hits. A unidirectional
320 :     best hit may exist from the source genome to the target genome or in the reverse
321 :     direction from the targtet genome to the source genome. The cache directory itself
322 :     is divided into subdirectories by organism. The subdirectory has the source genome
323 :     name and the files themselves are named by the target genome.
324 :    
325 :     Some of the files are invalid and will be erased when they are found. A file is
326 :     considered invalid if it has a non-numeric value in a numeric column or if it
327 :     does not have any unidirectional hits from the target genome to the source
328 :     genome.
329 :    
330 :     The process of managing the correspondence files is tricky and dangerous because
331 :     of the possibility of race conditions. It can take several minutes to generate a
332 :     file, and if two processes try to generate the same file at the same time we need
333 :     to make sure they don't step on each other.
334 :    
335 :     In stored files, the source genome ID is always lexically lower than the target
336 :     genome ID. If a correspondence in the reverse direction is desired, the converse
337 :     file is found and the contents flipped automatically as they are read. So, the
338 :     correspondence from B<360108.3> to B<100226.1> would be found in a file with the
339 :     name B<360108.3> in the directory for B<100226.1>. Since this file actually has
340 :     B<100226.1> as the source and B<360108.3> as the target, the columns are
341 :     re-ordered and the arrows reversed before the file contents are passed to the
342 :     caller.
343 :    
344 :     =head4 Gene Correspondence List
345 :    
346 :     A gene correspondence file contains 18 columns. These are usually packaged as
347 :     a reference to list of lists. Each sub-list has the following format.
348 :    
349 :     =over 4
350 :    
351 :     =item 0
352 :    
353 :     The ID of a PEG in genome 1.
354 :    
355 :     =item 1
356 :    
357 :     The ID of a PEG in genome 2 that is our best estimate of a "corresponding gene".
358 :    
359 :     =item 2
360 :    
361 :     Count of the number of pairs of matching genes were found in the context.
362 :    
363 :     =item 3
364 :    
365 :     Pairs of corresponding genes from the contexts.
366 :    
367 :     =item 4
368 :    
369 :     The function of the gene in genome 1.
370 :    
371 :     =item 5
372 :    
373 :     The function of the gene in genome 2.
374 :    
375 :     =item 6
376 :    
377 :     Comma-separated list of aliases for the gene in genome 1 (any protein with an
378 :     identical sequence is considered an alias, whether or not it is actually the
379 :     name of the same gene in the same genome).
380 :    
381 :     =item 7
382 :    
383 :     Comma-separated list of aliases for the gene in genome 2 (any protein with an
384 :     identical sequence is considered an alias, whether or not it is actually the
385 :     name of the same gene in the same genome).
386 :    
387 :     =item 8
388 :    
389 :     Bi-directional best hits will contain "<=>" in this column; otherwise, "->" will appear.
390 :    
391 :     =item 9
392 :    
393 :     Percent identity over the region of the detected match.
394 :    
395 :     =item 10
396 :    
397 :     The P-score for the detected match.
398 :    
399 :     =item 11
400 :    
401 :     Beginning match coordinate in the protein encoded by the gene in genome 1.
402 :    
403 :     =item 12
404 :    
405 :     Ending match coordinate in the protein encoded by the gene in genome 1.
406 :    
407 :     =item 13
408 :    
409 :     Length of the protein encoded by the gene in genome 1.
410 :    
411 :     =item 14
412 :    
413 :     Beginning match coordinate in the protein encoded by the gene in genome 2.
414 :    
415 :     =item 15
416 :    
417 :     Ending match coordinate in the protein encoded by the gene in genome 2.
418 :    
419 :     =item 16
420 :    
421 :     Length of the protein encoded by the gene in genome 2.
422 :    
423 :     =item 17
424 :    
425 :     Bit score for the match. Divide by the length of the longer PEG to get
426 :     what we often refer to as a "normalized bit score".
427 :    
428 :     =back
429 :    
430 :     In the actual files, there will also be reverse correspondences indicated by a
431 :     back-arrow ("<-") in item (8). The output returned by the servers, however,
432 :     is filtered so that only forward correspondences occur. If a converse file
433 :     is used, the columns are re-ordered and the arrows reversed so that it looks
434 :     correct.
435 :    
436 :     =cut
437 :    
438 :     # hash for reversing the arrows
439 :     use constant ARROW_FLIP => { '->' => '<-', '<=>' => '<=>', '<-' => '->' };
440 :     # list of columns that contain numeric values that need to be validated
441 :     use constant NUM_COLS => [2,9,10,11,12,13,14,15,16,17];
442 :    
443 :     =head3 CheckForGeneCorrespondenceFile
444 :    
445 :     my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);
446 :    
447 :     Try to find a gene correspondence file for the specified genome pairing. If the
448 :     file exists, its name and an indication of whether or not it is in the correct
449 :     direction will be returned.
450 : parrello 1.36
451 :     =over 4
452 :    
453 :     =item genome1
454 :    
455 : parrello 1.37 Source genome for the desired correspondence.
456 : parrello 1.36
457 :     =item genome2
458 :    
459 : parrello 1.37 Target genome for the desired correspondence.
460 : parrello 1.36
461 :     =item RETURN
462 :    
463 : parrello 1.37 Returns a two-element list. The first element is the name of the file containing the
464 :     correspondence, or C<undef> if the file does not exist. The second element is TRUE
465 :     if the correspondence would be forward or FALSE if the file needs to be flipped.
466 : parrello 1.36
467 :     =back
468 :    
469 :     =cut
470 :    
471 : parrello 1.37 sub CheckForGeneCorrespondenceFile {
472 : parrello 1.36 # Get the parameters.
473 :     my ($genome1, $genome2) = @_;
474 : parrello 1.37 # Declare the return variables.
475 :     my ($fileName, $converse);
476 :     # Determine the ordering of the genome IDs.
477 :     my ($corrFileName, $genomeA, $genomeB) = ComputeCorrespondenceFileName($genome1, $genome2);
478 :     $converse = ($genomeA ne $genome1);
479 :     # Look for a file containing the desired correspondence. (The code to check for a
480 :     # pre-computed file in the organism directories is currently turned off, because
481 :     # these files are all currently invalid.)
482 :     my $testFileName = "$FIG_Config::organisms/$genomeA/CorrToReferenceGenomes/$genomeB";
483 :     if (0 && -f $testFileName) {
484 : parrello 1.36 # Use the pre-computed file.
485 : parrello 1.44 Trace("Using pre-computed file $fileName for genome correspondence.") if T(Corr => 3);
486 : parrello 1.37 $fileName = $testFileName;
487 :     } elsif (-f $corrFileName) {
488 :     $fileName = $corrFileName;
489 : parrello 1.44 Trace("Using cached file $fileName for genome correspondence.") if T(Corr => 3);
490 : parrello 1.37 }
491 :     # Return the result.
492 :     return ($fileName, $converse);
493 :     }
494 :    
495 :    
496 :     =head3 ComputeCorrespondenceFileName
497 :    
498 :     my ($fileName, $genomeA, $genomeB) = ServerThing::ComputeCorrespondenceFileName($genome1, $genome2);
499 :    
500 :     Compute the name to be given to a genome correspondence file in the organism cache
501 :     and return the source and target genomes that would be in it.
502 :    
503 :     =over 4
504 :    
505 :     =item genome1
506 :    
507 :     Source genome for the desired correspondence.
508 :    
509 :     =item genome2
510 :    
511 :     Target genome for the desired correspondence.
512 :    
513 :     =item RETURN
514 :    
515 :     Returns a three-element list. The first element is the name of the file to contain the
516 :     correspondence, the second element is the name of the genome that would act as the
517 :     source genome in the file, and the third element is the name of the genome that would
518 :     act as the target genome in the file.
519 :    
520 :     =back
521 :    
522 :     =cut
523 :    
524 :     sub ComputeCorrespondenceFileName {
525 :     # Get the parameters.
526 :     my ($genome1, $genome2) = @_;
527 :     # Declare the return variables.
528 :     my ($fileName, $genomeA, $genomeB);
529 :     # Determine the ordering of the genome IDs.
530 : parrello 1.41 if (MustFlipGenomeIDs($genome1, $genome2)) {
531 : parrello 1.43 ($genomeA, $genomeB) = ($genome2, $genome1);
532 :     } else {
533 : parrello 1.37 ($genomeA, $genomeB) = ($genome1, $genome2);
534 :     }
535 :     # Insure the source organism has a subdirectory in the organism cache.
536 : parrello 1.47 my $orgDir = ComputeCorrespondenceDirectory($genomeA);
537 : parrello 1.37 # Compute the name of the correspondence file for the appropriate target genome.
538 :     $fileName = "$orgDir/$genomeB";
539 :     # Return the results.
540 :     return ($fileName, $genomeA, $genomeB);
541 :     }
542 :    
543 :    
544 : parrello 1.47 =head3 ComputeCorresopndenceDirectory
545 :    
546 :     my $dirName = ServerThing::ComputeCorrespondenceDirectory($genome);
547 :    
548 :     Return the name of the directory that would contain the correspondence files
549 :     for the specified genome.
550 :    
551 :     =over 4
552 :    
553 :     =item genome
554 :    
555 :     ID of the genome whose correspondence file directory is desired.
556 :    
557 :     =item RETURN
558 :    
559 :     Returns the name of the directory of interest.
560 :    
561 :     =back
562 :    
563 :     =cut
564 :    
565 :     sub ComputeCorrespondenceDirectory {
566 :     # Get the parameters.
567 :     my ($genome) = @_;
568 :     # Insure the source organism has a subdirectory in the organism cache.
569 :     my $retVal = "$FIG_Config::orgCache/$genome";
570 :     Tracer::Insure($retVal, 0777);
571 :     # Return it.
572 :     return $retVal;
573 :     }
574 :    
575 :    
576 : parrello 1.37 =head3 CreateGeneCorrespondenceFile
577 :    
578 :     my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);
579 :    
580 :     Create a new gene correspondence file in the organism cache for the specified
581 :     genome correspondence. The name of the new file will be returned along with
582 :     an indicator of whether or not it is in the correct direction.
583 :    
584 :     =over 4
585 :    
586 :     =item genome1
587 :    
588 :     Source genome for the desired correspondence.
589 :    
590 :     =item genome2
591 :    
592 :     Target genome for the desired correspondence.
593 :    
594 :     =item RETURN
595 :    
596 :     Returns a two-element list. The first element is the name of the file containing the
597 :     correspondence, or C<undef> if an error occurred. The second element is TRUE
598 :     if the correspondence would be forward or FALSE if the file needs to be flipped.
599 :    
600 :     =back
601 :    
602 :     =cut
603 :    
604 :     sub CreateGeneCorrespondenceFile {
605 :     # Get the parameters.
606 :     my ($genome1, $genome2) = @_;
607 :     # Declare the return variables.
608 :     my ($fileName, $converse);
609 :     # Compute the ultimate name for the correspondence file.
610 :     my ($corrFileName, $genomeA, $genomeB) = ComputeCorrespondenceFileName($genome1, $genome2);
611 :     $converse = ($genome1 ne $genomeA);
612 :     # Generate a temporary file name in the same directory. We'll build the temporary
613 :     # file and then rename it when we're done.
614 :     my $tempFileName = "$corrFileName.$$.tmp";
615 :     # This will be set to FALSE if we detect an error.
616 :     my $fileOK = 1;
617 :     # The file handles will be put in here.
618 :     my ($ih, $oh);
619 :     # Protect from errors.
620 :     eval {
621 :     # Open the temporary file for output.
622 :     $oh = Open(undef, ">$tempFileName");
623 :     # Open a pipe to get the correspondence data.
624 :     $ih = Open(undef, "$FIG_Config::bin/svr_corresponding_genes -u localhost $genomeA $genomeB |");
625 :     Trace("Creating correspondence file for $genomeA to $genomeB in temporary file $tempFileName.") if T(3);
626 :     # Copy the pipe date into the temporary file.
627 :     while (! eof $ih) {
628 :     my $line = <$ih>;
629 :     print $oh $line;
630 :     }
631 :     # Close both files. If the close fails we need to know: it means there was a pipe
632 :     # error.
633 :     $fileOK &&= close $ih;
634 :     $fileOK &&= close $oh;
635 :     };
636 :     if ($@) {
637 :     # Here a fatal error of some sort occurred. We need to force the files closed.
638 :     close $ih if $ih;
639 :     close $oh if $oh;
640 :     } elsif ($fileOK) {
641 :     # Here everything worked. Try to rename the temporary file to the real
642 :     # file name.
643 :     if (rename $tempFileName, $corrFileName) {
644 :     # Everything is ok, fix the permissions and return the file name.
645 :     chmod 0664, $corrFileName;
646 :     $fileName = $corrFileName;
647 : parrello 1.44 Trace("Created correspondence file $fileName.") if T(Corr => 3);
648 : parrello 1.37 }
649 :     }
650 :     # If the temporary file exists, delete it.
651 :     if (-f $tempFileName) {
652 :     unlink $tempFileName;
653 :     }
654 :     # Return the results.
655 :     return ($fileName, $converse);
656 :     }
657 :    
658 :    
659 : parrello 1.41 =head3 MustFlipGenomeIDs
660 :    
661 :     my $converse = ServerThing::MustFlipGenomeIDs($genome1, $genome2);
662 :    
663 :     Return TRUE if the specified genome IDs are out of order. When genome IDs are out of
664 :     order, they are stored in the converse order in correspondence files on the server.
665 :     This is a simple method that allows the caller to check for the need to flip.
666 :    
667 :     =over 4
668 :    
669 :     =item genome1
670 :    
671 :     ID of the proposed source genome.
672 :    
673 :     =item genome2
674 :    
675 :     ID of the proposed target genome.
676 :    
677 :     =item RETURN
678 :    
679 :     Returns TRUE if the first genome would be stored on the server as a target, FALSE if
680 :     it would be stored as a source.
681 :    
682 :     =cut
683 :    
684 :     sub MustFlipGenomeIDs {
685 :     # Get the parameters.
686 :     my ($genome1, $genome2) = @_;
687 :     # Return an indication.
688 :     return ($genome1 gt $genome2);
689 :     }
690 :    
691 :    
692 : parrello 1.37 =head3 ReadGeneCorrespondenceFile
693 :    
694 : parrello 1.40 my $list = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse, $all);
695 : parrello 1.37
696 :     Return the contents of the specified gene correspondence file in the form of
697 :     a list of lists, with backward correspondences filtered out. If the file is
698 :     for the converse of the desired correspondence, the columns will be reordered
699 :     automatically so that it looks as if the file were designed for the proper
700 :     direction.
701 :    
702 :     =over 4
703 :    
704 :     =item fileName
705 :    
706 :     The name of the gene correspondence file to read.
707 :    
708 :     =item converse (optional)
709 :    
710 :     TRUE if the file is for the converse of the desired correspondence, else FALSE.
711 :     If TRUE, the file columns will be reorderd automatically. The default is FALSE,
712 :     meaning we want to use the file as it appears on disk.
713 :    
714 : parrello 1.40 =item all (optional)
715 :    
716 :     TRUE if backward unidirectional correspondences should be included in the output.
717 :     The default is FALSE, in which case only forward and bidirectional correspondences
718 :     are included.
719 :    
720 : parrello 1.37 =item RETURN
721 :    
722 :     Returns a L</Gene Correspondence List> in the form of a reference to a list of lists.
723 :     If the file's contents are invalid or an error occurs, an undefined value will be
724 :     returned.
725 :    
726 :     =back
727 :    
728 :     =cut
729 :    
730 :     sub ReadGeneCorrespondenceFile {
731 :     # Get the parameters.
732 : parrello 1.40 my ($fileName, $converse, $all) = @_;
733 : parrello 1.37 # Declare the return variable. We will only put something in here if we are
734 :     # completely successful.
735 :     my $retVal;
736 :     # This value will be set to 1 if an error is detected.
737 :     my $error = 0;
738 :     # Try to open the file.
739 :     my $ih;
740 :     Trace("Reading correspondence file $fileName.") if T(3);
741 :     if (! open $ih, "<$fileName") {
742 :     # Here the open failed, so we have an error.
743 : parrello 1.44 Trace("Failed to open gene correspondence file $fileName: $!") if T(Corr => 1);
744 : parrello 1.37 $error = 1;
745 :     }
746 :     # The gene correspondence list will be built in here.
747 :     my @corrList;
748 :     # This variable will be set to TRUE if we find a reverse correspondence somewhere
749 :     # in the file. Not finding one is an error.
750 :     my $reverseFound = 0;
751 :     # Loop until we hit the end of the file or an error occurs. We must check the error
752 :     # first in case the file handle failed to open.
753 :     while (! $error && ! eof $ih) {
754 :     # Get the current line.
755 :     my @row = Tracer::GetLine($ih);
756 :     # Get the correspondence direction and check for a reverse arrow.
757 :     $reverseFound = 1 if ($row[8] eq '<-');
758 :     # If we're in converse mode, reformat the line.
759 :     if ($converse) {
760 : parrello 1.39 ReverseGeneCorrespondenceRow(\@row);
761 : parrello 1.37 }
762 :     # Validate the row.
763 :     if (ValidateGeneCorrespondenceRow(\@row)) {
764 : parrello 1.44 Trace("Invalid row $. found in correspondence file $fileName.") if T(Corr => 1);
765 : parrello 1.37 $error = 1;
766 :     }
767 :     # If this row is in the correct direction, keep it.
768 : parrello 1.40 if ($all || $row[8] ne '<-') {
769 : parrello 1.37 push @corrList, \@row;
770 :     }
771 :     }
772 :     # Close the input file.
773 :     close $ih;
774 :     # If we have no errors and we found a reverse arrow, keep the result.
775 :     if (! $error) {
776 :     if ($reverseFound) {
777 :     $retVal = \@corrList;
778 : parrello 1.36 } else {
779 : parrello 1.44 Trace("No reverse arrow found in correspondence file $fileName.") if T(Corr => 1);
780 : parrello 1.37 }
781 :     }
782 :     # Return the result (if any).
783 :     return $retVal;
784 :     }
785 :    
786 : parrello 1.39 =head3 ReverseGeneCorrespondenceRow
787 :    
788 :     ServerThing::ReverseGeneCorrespondenceRow($row)
789 :    
790 :     Convert a gene correspondence row to represent the converse correspondence. The
791 :     elements in the row will be reordered to represent a correspondence from the
792 :     target genome to the source genome.
793 :    
794 :     =over 4
795 :    
796 :     =item row
797 :    
798 :     Reference to a list containing a single row from a L</Gene Correspondence List>.
799 :    
800 :     =back
801 :    
802 :     =cut
803 :    
804 :     sub ReverseGeneCorrespondenceRow {
805 :     # Get the parameters.
806 :     my ($row) = @_;
807 :     # Flip the row in place.
808 :     ($row->[1], $row->[0], $row->[2], $row->[3], $row->[5], $row->[4], $row->[7],
809 : parrello 1.41 $row->[6], $row->[8], $row->[9], $row->[10], $row->[14],
810 : parrello 1.39 $row->[15], $row->[16], $row->[11], $row->[12], $row->[13], $row->[17]) = @$row;
811 : parrello 1.41 # Flip the arrow.
812 :     $row->[8] = ARROW_FLIP->{$row->[8]};
813 :     # Flip the pairs.
814 : parrello 1.42 my @elements = split /,/, $row->[3];
815 : parrello 1.45 $row->[3] = join(",", map { join(":", reverse split /:/, $_) } @elements);
816 : parrello 1.39 }
817 : parrello 1.37
818 :     =head3 ValidateGeneCorrespondenceRow
819 :    
820 :     my $errorCount = ServerThing::ValidateGeneCorrespondenceRow($row);
821 :    
822 :     Validate a gene correspondence row. The numeric fields are checked to insure they
823 :     are numeric and the source and target gene IDs are validated. The return value will
824 :     indicate the number of errors found.
825 :    
826 :     =over 4
827 :    
828 :     =item row
829 :    
830 :     Reference to a list containing a single row from a L</Gene Correspondence List>.
831 :    
832 :     =item RETURN
833 :    
834 :     Returns the number of errors found in the row. A return of C<0> indicates the row
835 :     is valid.
836 :    
837 :     =back
838 :    
839 :     =cut
840 :    
841 :     sub ValidateGeneCorrespondenceRow {
842 :     # Get the parameters.
843 :     my ($row, $genome1, $genome2) = @_;
844 :     # Denote no errors have been found so far.
845 :     my $retVal = 0;
846 :     # Check for non-numeric values in the number columns.
847 :     for my $col (@{NUM_COLS()}) {
848 :     unless ($row->[$col] =~ /^-?\d+\.?\d*(?:e[+-]?\d+)?$/) {
849 : parrello 1.44 Trace("Gene correspondence error. \"$row->[$col]\" not numeric.") if T(Corr => 2);
850 : parrello 1.37 $retVal++;
851 :     }
852 :     }
853 :     # Check the gene IDs.
854 :     for my $col (0, 1) {
855 :     unless ($row->[$col] =~ /^fig\|\d+\.\d+\.\w+\.\d+$/) {
856 : parrello 1.44 Trace("Gene correspondence error. \"$row->[$col]\" not a gene ID.") if T(Corr => 2);
857 : parrello 1.37 $retVal++;
858 : parrello 1.36 }
859 :     }
860 : parrello 1.37 # Verify the arrow.
861 :     unless (exists ARROW_FLIP->{$row->[8]}) {
862 : parrello 1.44 Trace("Gene correspondence error. \"$row->[8]\" not an arrow.") if T(Corr => 2);
863 : parrello 1.37 $retVal++;
864 :     }
865 :     # Return the error count.
866 : parrello 1.36 return $retVal;
867 :     }
868 :    
869 : parrello 1.9
870 :     =head2 Internal Utility Methods
871 :    
872 :     The methods in this section are used internally by this package.
873 :    
874 : parrello 1.6 =head3 RunRequest
875 :    
876 : parrello 1.9 ServerThing::RunRequest($cgi, $serverName);
877 : parrello 1.6
878 :     Run a request from the specified server using the incoming CGI parameter
879 :     object for the parameters.
880 :    
881 :     =over 4
882 :    
883 :     =item cgi
884 :    
885 : parrello 1.49 CGI query object containing the parameters from the web service request. The
886 :     significant parameters are as follows.
887 :    
888 :     =over 8
889 :    
890 :     =item function
891 :    
892 :     Name of the function to run.
893 :    
894 :     =item args
895 :    
896 :     Parameters for the function.
897 :    
898 :     =item encoding
899 :    
900 :     Encoding scheme for the function parameters, either C<yaml> (the default) or C<json> (used
901 :     by the Java interface).
902 :    
903 :     =back
904 :    
905 :     Certain unusual requests can come in outside of the standard function interface.
906 :     These are indicated by special parameters that override all the others.
907 :    
908 :     =over 8
909 :    
910 :     =item pod
911 :    
912 :     Display a POD documentation module.
913 :    
914 :     =item code
915 :    
916 :     Display an example code file.
917 :    
918 :     =item file
919 :    
920 :     Transfer a file (not implemented).
921 :    
922 :     =back
923 : parrello 1.6
924 : parrello 1.13 =item serverThing
925 : parrello 1.6
926 : parrello 1.13 Server object against which to run the request.
927 : parrello 1.6
928 :     =back
929 :    
930 :     =cut
931 :    
932 :     sub RunRequest {
933 :     # Get the parameters.
934 : parrello 1.13 my ($cgi, $serverThing, $docURL) = @_;
935 : parrello 1.9 # Determine the request type.
936 : parrello 1.52 my $module = $cgi->param('pod');
937 :     if ($module) {
938 :     # Here we have a documentation request.
939 :     if ($module eq 'ServerScripts') {
940 :     # Here we list the server scripts.
941 :     require ListServerScripts;
942 :     ListServerScripts::main();
943 :     } else {
944 :     # In this case, we produce POD HTML.
945 :     ProducePod($cgi->param('pod'));
946 :     }
947 : disz 1.31 } elsif ($cgi->param('code')) {
948 : parrello 1.32 # Here the user wants to see the code for one of our scripts.
949 :     LineNumberize($cgi->param('code'));
950 : parrello 1.9 } elsif ($cgi->param('file')) {
951 :     # Here we have a file request. Process according to the type.
952 :     my $type = $cgi->param('file');
953 :     if ($type eq 'open') {
954 :     OpenFile($cgi->param('name'));
955 :     } elsif ($type eq 'create') {
956 :     CreateFile();
957 :     } elsif ($type eq 'read') {
958 :     ReadChunk($cgi->param('name'), $cgi->param('location'), $cgi->param('size'));
959 :     } elsif ($type eq 'write') {
960 :     WriteChunk($cgi->param('name'), $cgi->param('data'));
961 :     } else {
962 :     Die("Invalid file function \"$type\".");
963 : parrello 1.4 }
964 : parrello 1.1 } else {
965 : parrello 1.9 # The default is a function request. Get the function name.
966 : parrello 1.4 my $function = $cgi->param('function') || "";
967 : parrello 1.15 Trace("Server function for task $$ is $function.") if T(3);
968 : parrello 1.4 # Insure the function name is valid.
969 :     Die("Invalid function name.")
970 :     if $function =~ /\W/;
971 : parrello 1.51 # Determing the encoding scheme. The default is YAML.
972 :     my $encoding = $cgi->param('encoding') || 'yaml';
973 : parrello 1.4 # The parameter structure will go in here.
974 :     my $args;
975 :     # Start the timer.
976 :     my $start = time();
977 :     # The output document goes in here.
978 :     my $document;
979 :     # The sapling database goes in here.
980 :     my $sapling;
981 :     # Protect from errors.
982 : parrello 1.1 eval {
983 : parrello 1.49 # Here we parse the arguments. This is affected by the encoding parameter.
984 :     # Get the argument string.
985 :     my $argString = $cgi->param('args');
986 :     if ($encoding eq 'yaml') {
987 :     # Parse the arguments using YAML.
988 :     $args = YAML::Load($argString);
989 :     } elsif ($encoding eq 'json') {
990 :     # Parse the arguments using JSON.
991 : parrello 1.50 Trace("Incoming string is:\n$argString") if T(3);
992 : parrello 1.49 $args = JSON::Any->jsonToObj($argString);
993 :     } else {
994 :     Die("Invalid encoding type $encoding.");
995 :     }
996 : parrello 1.1 };
997 : parrello 1.4 # Check to make sure we got everything.
998 : parrello 1.1 if ($@) {
999 : parrello 1.10 SendError($@, "Error formatting parameters.");
1000 : parrello 1.4 } elsif (! $function) {
1001 : parrello 1.10 SendError("No function specified.", "No function specified.");
1002 : parrello 1.1 } else {
1003 : parrello 1.30 $document = eval { $serverThing->$function($args) };
1004 : parrello 1.1 # If we have an error, create an error document.
1005 :     if ($@) {
1006 : parrello 1.13 SendError($@, "Error detected by service.");
1007 : parrello 1.32 Trace("Error encountered by service: $@") if T(0);
1008 : parrello 1.1 } else {
1009 : parrello 1.51 # No error, so we output the result. Start with an HTML header.
1010 : parrello 1.13 print $cgi->header(-type => 'text/plain');
1011 : parrello 1.51 # The nature of the output depends on the encoding type.
1012 :     my $string;
1013 :     if ($encoding eq 'yaml') {
1014 :     $string = YAML::Dump($document);
1015 :     } else {
1016 :     $string = JSON::Any->objToJson($document);
1017 :     }
1018 : parrello 1.18 print $string;
1019 :     MemTrace(length($string) . " bytes returned from $function by task $$.") if T(Memory => 3);
1020 : parrello 1.1 }
1021 :     }
1022 : parrello 1.4 # Stop the timer.
1023 :     my $duration = int(time() - $start + 0.5);
1024 : parrello 1.29 Trace("Function $function executed in $duration seconds by task $$.") if T(2);
1025 : parrello 1.1 }
1026 :     }
1027 :    
1028 : parrello 1.9 =head3 CreateFile
1029 :    
1030 :     ServerThing::CreateFile();
1031 :    
1032 :     Create a new, empty temporary file and send its name back to the client.
1033 :    
1034 :     =cut
1035 :    
1036 :     sub CreateFile {
1037 :     ##TODO: Code
1038 :     }
1039 :    
1040 :     =head3 OpenFile
1041 : parrello 1.6
1042 : parrello 1.9 ServerThing::OpenFile($name);
1043 : parrello 1.1
1044 : parrello 1.9 Send the length of the named file back to the client.
1045 :    
1046 :     =over 4
1047 :    
1048 :     =item name
1049 :    
1050 :     ##TODO: name description
1051 :    
1052 :     =back
1053 :    
1054 :     =cut
1055 :    
1056 :     sub OpenFile {
1057 :     # Get the parameters.
1058 :     my ($name) = @_;
1059 :     ##TODO: Code
1060 :     }
1061 : parrello 1.1
1062 : parrello 1.9 =head3 ReadChunk
1063 : parrello 1.1
1064 : parrello 1.9 ServerThing::ReadChunk($name, $location, $size);
1065 : parrello 1.1
1066 : parrello 1.9 Read the indicated number of bytes from the specified location of the
1067 :     named file and send them back to the client.
1068 : parrello 1.1
1069 :     =over 4
1070 :    
1071 :     =item name
1072 :    
1073 : parrello 1.9 ##TODO: name description
1074 : parrello 1.1
1075 : parrello 1.9 =item location
1076 : parrello 1.1
1077 : parrello 1.9 ##TODO: location description
1078 : parrello 1.1
1079 : parrello 1.9 =item size
1080 : parrello 1.1
1081 : parrello 1.9 ##TODO: size description
1082 : parrello 1.1
1083 :     =back
1084 :    
1085 :     =cut
1086 :    
1087 : parrello 1.9 sub ReadChunk {
1088 : parrello 1.1 # Get the parameters.
1089 : parrello 1.9 my ($name, $location, $size) = @_;
1090 :     ##TODO: Code
1091 : parrello 1.1 }
1092 :    
1093 : parrello 1.9 =head3 WriteChunk
1094 : parrello 1.1
1095 : parrello 1.9 ServerThing::WriteChunk($name, $data);
1096 : parrello 1.8
1097 : parrello 1.9 Write the specified data to the named file.
1098 : parrello 1.8
1099 :     =over 4
1100 :    
1101 :     =item name
1102 :    
1103 : parrello 1.9 ##TODO: name description
1104 :    
1105 :     =item data
1106 :    
1107 :     ##TODO: data description
1108 :    
1109 :     =back
1110 :    
1111 :     =cut
1112 :    
1113 :     sub WriteChunk {
1114 :     # Get the parameters.
1115 :     my ($name, $data) = @_;
1116 :     ##TODO: Code
1117 :     }
1118 :    
1119 :    
1120 : disz 1.31 =head3 LineNumberize
1121 :    
1122 :     ServerThing::LineNumberize($module);
1123 :    
1124 :     Output the module line by line with line numbers
1125 :    
1126 :     =over 4
1127 :    
1128 :     =item module
1129 :    
1130 :     Name of the module to line numberized
1131 :    
1132 :     =back
1133 :    
1134 :     =cut
1135 :    
1136 :     sub LineNumberize {
1137 :     # Get the parameters.
1138 :     my ($module) = @_;
1139 :     my $fks_path = "$FIG_Config::fig_disk/dist/releases/current/FigKernelScripts/$module";
1140 :     # Start the output page.
1141 :     print CGI::header();
1142 :     print CGI::start_html(-title => 'Documentation Page',
1143 :     -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });
1144 :     # Protect from errors.
1145 :     eval {
1146 : parrello 1.32 if (-e $fks_path) {
1147 :     print "<pre>\n";
1148 :     my $i = 1;
1149 :     foreach my $line (`cat $fks_path`) {
1150 :     print "$i.\t$line";
1151 :     $i++;
1152 :     }
1153 :     print "</pre>\n";
1154 :     } else {
1155 :     print "File $fks_path not found";
1156 :     }
1157 : disz 1.31 };
1158 :     # Process any error.
1159 :     if ($@) {
1160 :     print CGI::blockquote({ class => 'error' }, $@);
1161 :     }
1162 :     # Close off the page.
1163 :     print CGI::end_html();
1164 :    
1165 :     }
1166 :    
1167 : parrello 1.9 =head3 ProducePod
1168 :    
1169 :     ServerThing::ProducePod($module);
1170 :    
1171 :     Output the POD documentation for the specified module.
1172 :    
1173 :     =over 4
1174 : parrello 1.8
1175 : parrello 1.9 =item module
1176 : parrello 1.8
1177 : parrello 1.9 Name of the module whose POD document is to be displayed.
1178 : parrello 1.8
1179 :     =back
1180 :    
1181 :     =cut
1182 :    
1183 : parrello 1.9 sub ProducePod {
1184 : parrello 1.8 # Get the parameters.
1185 : parrello 1.9 my ($module) = @_;
1186 :     # Start the output page.
1187 :     print CGI::header();
1188 : parrello 1.46 print CGI::start_html(-title => "$module Documentation Page",
1189 : parrello 1.9 -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });
1190 :     # Protect from errors.
1191 :     eval {
1192 :     # We'll format the HTML text in here.
1193 :     require DocUtils;
1194 : parrello 1.20 my $html = DocUtils::ShowPod($module, "http://servers.nmpdr.org/sapling/server.cgi?pod=");
1195 : parrello 1.9 # Output the POD HTML.
1196 :     print $html;
1197 :     };
1198 :     # Process any error.
1199 :     if ($@) {
1200 :     print CGI::blockquote({ class => 'error' }, $@);
1201 : parrello 1.8 }
1202 : parrello 1.9 # Close off the page.
1203 :     print CGI::end_html();
1204 :    
1205 : parrello 1.8 }
1206 :    
1207 :     =head3 TraceErrorLog
1208 :    
1209 :     ServerThing::TraceErrorLog($name, $errorLog);
1210 :    
1211 :     Trace the specified error log file. This is a very dinky routine that
1212 :     performs a task required by L</RunTool> in multiple places.
1213 :    
1214 :     =over 4
1215 :    
1216 :     =item name
1217 :    
1218 :     Name of the tool relevant to the log file.
1219 :    
1220 :     =item errorLog
1221 :    
1222 :     Name of the log file.
1223 :    
1224 :     =back
1225 :    
1226 :     =cut
1227 :    
1228 :     sub TraceErrorLog {
1229 :     my ($name, $errorLog) = @_;
1230 :     my $errorData = Tracer::GetFile($errorLog);
1231 :     Trace("$name error log:\n$errorData");
1232 :     }
1233 :    
1234 : parrello 1.10 =head3 SendError
1235 :    
1236 :     ServerThing::SendError($message, $status);
1237 :    
1238 :     Fail an HTTP request with the specified error message and the specified
1239 :     status message.
1240 :    
1241 :     =over 4
1242 :    
1243 :     =item message
1244 :    
1245 :     Detailed error message. This is sent as the page content.
1246 :    
1247 :     =item status
1248 :    
1249 :     Status message. This is sent as part of the status code.
1250 :    
1251 :     =back
1252 :    
1253 :     =cut
1254 :    
1255 :     sub SendError {
1256 :     # Get the parameters.
1257 :     my ($message, $status) = @_;
1258 :     Trace("Error \"$status\" $message") if T(2);
1259 : parrello 1.30 # Check for a DBserver error. These can be retried and get a special status
1260 :     # code.
1261 :     my $realStatus;
1262 :     if ($message =~ /DBServer Error:\s+/) {
1263 :     $realStatus = "503 $status";
1264 :     } else {
1265 :     $realStatus = "500 $status";
1266 :     }
1267 : parrello 1.10 # Print the header and the status message.
1268 :     print CGI::header(-type => 'text/plain',
1269 : parrello 1.30 -status => $realStatus);
1270 : parrello 1.10 # Print the detailed message.
1271 :     print $message;
1272 :     }
1273 :    
1274 :    
1275 : disz 1.31 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3