[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.30, Fri Dec 11 21:21:04 2009 UTC revision 1.51, Wed Apr 28 15:46:38 2010 UTC
# Line 5  Line 5 
5      use strict;      use strict;
6      use Tracer;      use Tracer;
7      use YAML;      use YAML;
8        use JSON::Any;
9      use ERDB;      use ERDB;
10      use TestUtils;      use TestUtils;
11      use Time::HiRes;      use Time::HiRes;
# Line 14  Line 15 
15      no warnings qw(once);      no warnings qw(once);
16    
17      # Maximum number of requests to run per invocation.      # Maximum number of requests to run per invocation.
18      use constant MAX_REQUESTS => 5000;      use constant MAX_REQUESTS => 50;
19    
20  =head1 General Server Helper  =head1 General Server Helper
21    
# Line 33  Line 34 
34      # Set up tracing. We never do CGI tracing here; the only question is whether      # 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      # or not the caller passed in a tracing key. If he didn't, we use the server
36      # name.      # name.
37      ETracing($key || $serverName);      ETracing($key || $serverName, destType => 'APPEND', level => '0 ServerThing');
38      # Turn off YAML compression, which causes problems with some of our hash keys.      # Turn off YAML compression, which causes problems with some of our hash keys.
39      $YAML::CompressSeries = 0;      $YAML::CompressSeries = 0;
40      # Create the server object.      # Create the server object.
# Line 199  Line 200 
200  sub GetIdList {  sub GetIdList {
201      # Get the parameters.      # Get the parameters.
202      my ($name, $args, $optional) = @_;      my ($name, $args, $optional) = @_;
203      # Try to get the IDs from the argument structure.      # Declare the return variable.
204      my $retVal = $args->{$name};      my $retVal;
205        # Check the argument format.
206        if (! defined $args && $optional) {
207            # Here there are no parameters, but the arguments are optional so it's
208            # okay.
209            $retVal = [];
210        } elsif (ref $args ne 'HASH') {
211            # Here we have an invalid parameter structure.
212            Confess("No '$name' parameter present.");
213        } else {
214            # Here we have a hash with potential parameters in it. Try to get the
215            # IDs from the argument structure.
216            $retVal = $args->{$name};
217      # Was a member found?      # Was a member found?
218      if (! defined $retVal) {      if (! defined $retVal) {
219          # No. If we're optional, return an empty list; otherwise throw an error.          # No. If we're optional, return an empty list; otherwise throw an error.
# Line 210  Line 223 
223              Confess("No '$name' parameter found.");              Confess("No '$name' parameter found.");
224          }          }
225      } else {      } else {
226          # Here we found something. Get the parameter type. We was a list reference.              # Here we found something. Get the parameter type. We want a list reference.
227          # If it's a scalar, we'll convert it to a singleton list. If it's anything          # If it's a scalar, we'll convert it to a singleton list. If it's anything
228          # else, it's an error.          # else, it's an error.
229          my $type = ref $retVal;          my $type = ref $retVal;
# Line 220  Line 233 
233              Confess("The '$name' parameter must be a list.");              Confess("The '$name' parameter must be a list.");
234          }          }
235      }      }
236        }
237      # Return the result.      # Return the result.
238      return $retVal;      return $retVal;
239  }  }
# Line 279  Line 293 
293  }  }
294    
295    
296    =head2 Gene Correspondence File Methods
297    
298    These methods relate to gene correspondence files, which are generated by the
299    L<svr_corresponding_genes.pl> script. Correspondence files are cached in the
300    organism cache (I<$FIG_Config::orgCache>) directory. Eventually they will be
301    copied into the organism directories themselves. At that point, the code below
302    will be modified to check the organism directories first and use the cache
303    directory if no file is found there.
304    
305    A gene correspondence file contains correspondences from a source genome to a
306    target genome. Most such correspondences are bidirectional best hits. A unidirectional
307    best hit may exist from the source genome to the target genome or in the reverse
308    direction from the targtet genome to the source genome. The cache directory itself
309    is divided into subdirectories by organism. The subdirectory has the source genome
310    name and the files themselves are named by the target genome.
311    
312    Some of the files are invalid and will be erased when they are found. A file is
313    considered invalid if it has a non-numeric value in a numeric column or if it
314    does not have any unidirectional hits from the target genome to the source
315    genome.
316    
317    The process of managing the correspondence files is tricky and dangerous because
318    of the possibility of race conditions. It can take several minutes to generate a
319    file, and if two processes try to generate the same file at the same time we need
320    to make sure they don't step on each other.
321    
322    In stored files, the source genome ID is always lexically lower than the target
323    genome ID. If a correspondence in the reverse direction is desired, the converse
324    file is found and the contents flipped automatically as they are read. So, the
325    correspondence from B<360108.3> to B<100226.1> would be found in a file with the
326    name B<360108.3> in the directory for B<100226.1>. Since this file actually has
327    B<100226.1> as the source and B<360108.3> as the target, the columns are
328    re-ordered and the arrows reversed before the file contents are passed to the
329    caller.
330    
331    =head4 Gene Correspondence List
332    
333    A gene correspondence file contains 18 columns. These are usually packaged as
334    a reference to list of lists. Each sub-list has the following format.
335    
336    =over 4
337    
338    =item 0
339    
340    The ID of a PEG in genome 1.
341    
342    =item 1
343    
344    The ID of a PEG in genome 2 that is our best estimate of a "corresponding gene".
345    
346    =item 2
347    
348    Count of the number of pairs of matching genes were found in the context.
349    
350    =item 3
351    
352    Pairs of corresponding genes from the contexts.
353    
354    =item 4
355    
356    The function of the gene in genome 1.
357    
358    =item 5
359    
360    The function of the gene in genome 2.
361    
362    =item 6
363    
364    Comma-separated list of aliases for the gene in genome 1 (any protein with an
365    identical sequence is considered an alias, whether or not it is actually the
366    name of the same gene in the same genome).
367    
368    =item 7
369    
370    Comma-separated list of aliases for the gene in genome 2 (any protein with an
371    identical sequence is considered an alias, whether or not it is actually the
372    name of the same gene in the same genome).
373    
374    =item 8
375    
376    Bi-directional best hits will contain "<=>" in this column; otherwise, "->" will appear.
377    
378    =item 9
379    
380    Percent identity over the region of the detected match.
381    
382    =item 10
383    
384    The P-score for the detected match.
385    
386    =item 11
387    
388    Beginning match coordinate in the protein encoded by the gene in genome 1.
389    
390    =item 12
391    
392    Ending match coordinate in the protein encoded by the gene in genome 1.
393    
394    =item 13
395    
396    Length of the protein encoded by the gene in genome 1.
397    
398    =item 14
399    
400    Beginning match coordinate in the protein encoded by the gene in genome 2.
401    
402    =item 15
403    
404    Ending match coordinate in the protein encoded by the gene in genome 2.
405    
406    =item 16
407    
408    Length of the protein encoded by the gene in genome 2.
409    
410    =item 17
411    
412    Bit score for the match. Divide by the length of the longer PEG to get
413    what we often refer to as a "normalized bit score".
414    
415    =back
416    
417    In the actual files, there will also be reverse correspondences indicated by a
418    back-arrow ("<-") in item (8). The output returned by the servers, however,
419    is filtered so that only forward correspondences occur. If a converse file
420    is used, the columns are re-ordered and the arrows reversed so that it looks
421    correct.
422    
423    =cut
424    
425    # hash for reversing the arrows
426    use constant ARROW_FLIP => { '->' => '<-', '<=>' => '<=>', '<-' => '->' };
427    # list of columns that contain numeric values that need to be validated
428    use constant NUM_COLS => [2,9,10,11,12,13,14,15,16,17];
429    
430    =head3 CheckForGeneCorrespondenceFile
431    
432        my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);
433    
434    Try to find a gene correspondence file for the specified genome pairing. If the
435    file exists, its name and an indication of whether or not it is in the correct
436    direction will be returned.
437    
438    =over 4
439    
440    =item genome1
441    
442    Source genome for the desired correspondence.
443    
444    =item genome2
445    
446    Target genome for the desired correspondence.
447    
448    =item RETURN
449    
450    Returns a two-element list. The first element is the name of the file containing the
451    correspondence, or C<undef> if the file does not exist. The second element is TRUE
452    if the correspondence would be forward or FALSE if the file needs to be flipped.
453    
454    =back
455    
456    =cut
457    
458    sub CheckForGeneCorrespondenceFile {
459        # Get the parameters.
460        my ($genome1, $genome2) = @_;
461        # Declare the return variables.
462        my ($fileName, $converse);
463        # Determine the ordering of the genome IDs.
464        my ($corrFileName, $genomeA, $genomeB) = ComputeCorrespondenceFileName($genome1, $genome2);
465        $converse = ($genomeA ne $genome1);
466        # Look for a file containing the desired correspondence. (The code to check for a
467        # pre-computed file in the organism directories is currently turned off, because
468        # these files are all currently invalid.)
469        my $testFileName = "$FIG_Config::organisms/$genomeA/CorrToReferenceGenomes/$genomeB";
470        if (0 && -f $testFileName) {
471            # Use the pre-computed file.
472            Trace("Using pre-computed file $fileName for genome correspondence.") if T(Corr => 3);
473            $fileName = $testFileName;
474        } elsif (-f $corrFileName) {
475            $fileName = $corrFileName;
476            Trace("Using cached file $fileName for genome correspondence.") if T(Corr => 3);
477        }
478        # Return the result.
479        return ($fileName, $converse);
480    }
481    
482    
483    =head3 ComputeCorrespondenceFileName
484    
485        my ($fileName, $genomeA, $genomeB) = ServerThing::ComputeCorrespondenceFileName($genome1, $genome2);
486    
487    Compute the name to be given to a genome correspondence file in the organism cache
488    and return the source and target genomes that would be in it.
489    
490    =over 4
491    
492    =item genome1
493    
494    Source genome for the desired correspondence.
495    
496    =item genome2
497    
498    Target genome for the desired correspondence.
499    
500    =item RETURN
501    
502    Returns a three-element list. The first element is the name of the file to contain the
503    correspondence, the second element is the name of the genome that would act as the
504    source genome in the file, and the third element is the name of the genome that would
505    act as the target genome in the file.
506    
507    =back
508    
509    =cut
510    
511    sub ComputeCorrespondenceFileName {
512        # Get the parameters.
513        my ($genome1, $genome2) = @_;
514        # Declare the return variables.
515        my ($fileName, $genomeA, $genomeB);
516        # Determine the ordering of the genome IDs.
517        if (MustFlipGenomeIDs($genome1, $genome2)) {
518            ($genomeA, $genomeB) = ($genome2, $genome1);
519        } else {
520            ($genomeA, $genomeB) = ($genome1, $genome2);
521        }
522        # Insure the source organism has a subdirectory in the organism cache.
523        my $orgDir = ComputeCorrespondenceDirectory($genomeA);
524        # Compute the name of the correspondence file for the appropriate target genome.
525        $fileName = "$orgDir/$genomeB";
526        # Return the results.
527        return ($fileName, $genomeA, $genomeB);
528    }
529    
530    
531    =head3 ComputeCorresopndenceDirectory
532    
533        my $dirName = ServerThing::ComputeCorrespondenceDirectory($genome);
534    
535    Return the name of the directory that would contain the correspondence files
536    for the specified genome.
537    
538    =over 4
539    
540    =item genome
541    
542    ID of the genome whose correspondence file directory is desired.
543    
544    =item RETURN
545    
546    Returns the name of the directory of interest.
547    
548    =back
549    
550    =cut
551    
552    sub ComputeCorrespondenceDirectory {
553        # Get the parameters.
554        my ($genome) = @_;
555        # Insure the source organism has a subdirectory in the organism cache.
556        my $retVal = "$FIG_Config::orgCache/$genome";
557        Tracer::Insure($retVal, 0777);
558        # Return it.
559        return $retVal;
560    }
561    
562    
563    =head3 CreateGeneCorrespondenceFile
564    
565        my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);
566    
567    Create a new gene correspondence file in the organism cache for the specified
568    genome correspondence. The name of the new file will be returned along with
569    an indicator of whether or not it is in the correct direction.
570    
571    =over 4
572    
573    =item genome1
574    
575    Source genome for the desired correspondence.
576    
577    =item genome2
578    
579    Target genome for the desired correspondence.
580    
581    =item RETURN
582    
583    Returns a two-element list. The first element is the name of the file containing the
584    correspondence, or C<undef> if an error occurred. The second element is TRUE
585    if the correspondence would be forward or FALSE if the file needs to be flipped.
586    
587    =back
588    
589    =cut
590    
591    sub CreateGeneCorrespondenceFile {
592        # Get the parameters.
593        my ($genome1, $genome2) = @_;
594        # Declare the return variables.
595        my ($fileName, $converse);
596        # Compute the ultimate name for the correspondence file.
597        my ($corrFileName, $genomeA, $genomeB) = ComputeCorrespondenceFileName($genome1, $genome2);
598        $converse = ($genome1 ne $genomeA);
599        # Generate a temporary file name in the same directory. We'll build the temporary
600        # file and then rename it when we're done.
601        my $tempFileName = "$corrFileName.$$.tmp";
602        # This will be set to FALSE if we detect an error.
603        my $fileOK = 1;
604        # The file handles will be put in here.
605        my ($ih, $oh);
606        # Protect from errors.
607        eval {
608            # Open the temporary file for output.
609            $oh = Open(undef, ">$tempFileName");
610            # Open a pipe to get the correspondence data.
611            $ih = Open(undef, "$FIG_Config::bin/svr_corresponding_genes -u localhost $genomeA $genomeB |");
612            Trace("Creating correspondence file for $genomeA to $genomeB in temporary file $tempFileName.") if T(3);
613            # Copy the pipe date into the temporary file.
614            while (! eof $ih) {
615                my $line = <$ih>;
616                print $oh $line;
617            }
618            # Close both files. If the close fails we need to know: it means there was a pipe
619            # error.
620            $fileOK &&= close $ih;
621            $fileOK &&= close $oh;
622        };
623        if ($@) {
624            # Here a fatal error of some sort occurred. We need to force the files closed.
625            close $ih if $ih;
626            close $oh if $oh;
627        } elsif ($fileOK) {
628            # Here everything worked. Try to rename the temporary file to the real
629            # file name.
630            if (rename $tempFileName, $corrFileName) {
631                # Everything is ok, fix the permissions and return the file name.
632                chmod 0664, $corrFileName;
633                $fileName = $corrFileName;
634                Trace("Created correspondence file $fileName.") if T(Corr => 3);
635            }
636        }
637        # If the temporary file exists, delete it.
638        if (-f $tempFileName) {
639            unlink $tempFileName;
640        }
641        # Return the results.
642        return ($fileName, $converse);
643    }
644    
645    
646    =head3 MustFlipGenomeIDs
647    
648        my $converse = ServerThing::MustFlipGenomeIDs($genome1, $genome2);
649    
650    Return TRUE if the specified genome IDs are out of order. When genome IDs are out of
651    order, they are stored in the converse order in correspondence files on the server.
652    This is a simple method that allows the caller to check for the need to flip.
653    
654    =over 4
655    
656    =item genome1
657    
658    ID of the proposed source genome.
659    
660    =item genome2
661    
662    ID of the proposed target genome.
663    
664    =item RETURN
665    
666    Returns TRUE if the first genome would be stored on the server as a target, FALSE if
667    it would be stored as a source.
668    
669    =cut
670    
671    sub MustFlipGenomeIDs {
672        # Get the parameters.
673        my ($genome1, $genome2) = @_;
674        # Return an indication.
675        return ($genome1 gt $genome2);
676    }
677    
678    
679    =head3 ReadGeneCorrespondenceFile
680    
681        my $list = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse, $all);
682    
683    Return the contents of the specified gene correspondence file in the form of
684    a list of lists, with backward correspondences filtered out. If the file is
685    for the converse of the desired correspondence, the columns will be reordered
686    automatically so that it looks as if the file were designed for the proper
687    direction.
688    
689    =over 4
690    
691    =item fileName
692    
693    The name of the gene correspondence file to read.
694    
695    =item converse (optional)
696    
697    TRUE if the file is for the converse of the desired correspondence, else FALSE.
698    If TRUE, the file columns will be reorderd automatically. The default is FALSE,
699    meaning we want to use the file as it appears on disk.
700    
701    =item all (optional)
702    
703    TRUE if backward unidirectional correspondences should be included in the output.
704    The default is FALSE, in which case only forward and bidirectional correspondences
705    are included.
706    
707    =item RETURN
708    
709    Returns a L</Gene Correspondence List> in the form of a reference to a list of lists.
710    If the file's contents are invalid or an error occurs, an undefined value will be
711    returned.
712    
713    =back
714    
715    =cut
716    
717    sub ReadGeneCorrespondenceFile {
718        # Get the parameters.
719        my ($fileName, $converse, $all) = @_;
720        # Declare the return variable. We will only put something in here if we are
721        # completely successful.
722        my $retVal;
723        # This value will be set to 1 if an error is detected.
724        my $error = 0;
725        # Try to open the file.
726        my $ih;
727        Trace("Reading correspondence file $fileName.") if T(3);
728        if (! open $ih, "<$fileName") {
729            # Here the open failed, so we have an error.
730            Trace("Failed to open gene correspondence file $fileName: $!") if T(Corr => 1);
731            $error = 1;
732        }
733        # The gene correspondence list will be built in here.
734        my @corrList;
735        # This variable will be set to TRUE if we find a reverse correspondence somewhere
736        # in the file. Not finding one is an error.
737        my $reverseFound = 0;
738        # Loop until we hit the end of the file or an error occurs. We must check the error
739        # first in case the file handle failed to open.
740        while (! $error && ! eof $ih) {
741            # Get the current line.
742            my @row = Tracer::GetLine($ih);
743            # Get the correspondence direction and check for a reverse arrow.
744            $reverseFound = 1 if ($row[8] eq '<-');
745            # If we're in converse mode, reformat the line.
746            if ($converse) {
747                ReverseGeneCorrespondenceRow(\@row);
748            }
749            # Validate the row.
750            if (ValidateGeneCorrespondenceRow(\@row)) {
751                Trace("Invalid row $. found in correspondence file $fileName.") if T(Corr => 1);
752                $error = 1;
753            }
754            # If this row is in the correct direction, keep it.
755            if ($all || $row[8] ne '<-') {
756                push @corrList, \@row;
757            }
758        }
759        # Close the input file.
760        close $ih;
761        # If we have no errors and we found a reverse arrow, keep the result.
762        if (! $error) {
763            if ($reverseFound) {
764                $retVal = \@corrList;
765            } else {
766                Trace("No reverse arrow found in correspondence file $fileName.") if T(Corr => 1);
767            }
768        }
769        # Return the result (if any).
770        return $retVal;
771    }
772    
773    =head3 ReverseGeneCorrespondenceRow
774    
775        ServerThing::ReverseGeneCorrespondenceRow($row)
776    
777    Convert a gene correspondence row to represent the converse correspondence. The
778    elements in the row will be reordered to represent a correspondence from the
779    target genome to the source genome.
780    
781    =over 4
782    
783    =item row
784    
785    Reference to a list containing a single row from a L</Gene Correspondence List>.
786    
787    =back
788    
789    =cut
790    
791    sub ReverseGeneCorrespondenceRow {
792        # Get the parameters.
793        my ($row) = @_;
794        # Flip the row in place.
795        ($row->[1], $row->[0], $row->[2], $row->[3], $row->[5], $row->[4], $row->[7],
796         $row->[6], $row->[8], $row->[9], $row->[10], $row->[14],
797         $row->[15], $row->[16], $row->[11], $row->[12], $row->[13], $row->[17]) = @$row;
798        # Flip the arrow.
799        $row->[8] = ARROW_FLIP->{$row->[8]};
800        # Flip the pairs.
801        my @elements = split /,/, $row->[3];
802        $row->[3] = join(",", map { join(":", reverse split /:/, $_) } @elements);
803    }
804    
805    =head3 ValidateGeneCorrespondenceRow
806    
807        my $errorCount = ServerThing::ValidateGeneCorrespondenceRow($row);
808    
809    Validate a gene correspondence row. The numeric fields are checked to insure they
810    are numeric and the source and target gene IDs are validated. The return value will
811    indicate the number of errors found.
812    
813    =over 4
814    
815    =item row
816    
817    Reference to a list containing a single row from a L</Gene Correspondence List>.
818    
819    =item RETURN
820    
821    Returns the number of errors found in the row. A return of C<0> indicates the row
822    is valid.
823    
824    =back
825    
826    =cut
827    
828    sub ValidateGeneCorrespondenceRow {
829        # Get the parameters.
830        my ($row, $genome1, $genome2) = @_;
831        # Denote no errors have been found so far.
832        my $retVal = 0;
833        # Check for non-numeric values in the number columns.
834        for my $col (@{NUM_COLS()}) {
835            unless ($row->[$col] =~ /^-?\d+\.?\d*(?:e[+-]?\d+)?$/) {
836                Trace("Gene correspondence error. \"$row->[$col]\" not numeric.") if T(Corr => 2);
837                $retVal++;
838            }
839        }
840        # Check the gene IDs.
841        for my $col (0, 1) {
842            unless ($row->[$col] =~ /^fig\|\d+\.\d+\.\w+\.\d+$/) {
843                Trace("Gene correspondence error. \"$row->[$col]\" not a gene ID.") if T(Corr => 2);
844                $retVal++;
845            }
846        }
847        # Verify the arrow.
848        unless (exists ARROW_FLIP->{$row->[8]}) {
849            Trace("Gene correspondence error. \"$row->[8]\" not an arrow.") if T(Corr => 2);
850            $retVal++;
851        }
852        # Return the error count.
853        return $retVal;
854    }
855    
856    
857  =head2 Internal Utility Methods  =head2 Internal Utility Methods
858    
859  The methods in this section are used internally by this package.  The methods in this section are used internally by this package.
# Line 294  Line 869 
869    
870  =item cgi  =item cgi
871    
872  CGI query object containing the parameters from the web service request.  CGI query object containing the parameters from the web service request. The
873    significant parameters are as follows.
874    
875    =over 8
876    
877    =item function
878    
879    Name of the function to run.
880    
881    =item args
882    
883    Parameters for the function.
884    
885    =item encoding
886    
887    Encoding scheme for the function parameters, either C<yaml> (the default) or C<json> (used
888    by the Java interface).
889    
890    =back
891    
892    Certain unusual requests can come in outside of the standard function interface.
893    These are indicated by special parameters that override all the others.
894    
895    =over 8
896    
897    =item pod
898    
899    Display a POD documentation module.
900    
901    =item code
902    
903    Display an example code file.
904    
905    =item file
906    
907    Transfer a file (not implemented).
908    
909    =back
910    
911  =item serverThing  =item serverThing
912    
# Line 311  Line 923 
923      if ($cgi->param('pod')) {      if ($cgi->param('pod')) {
924          # 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.
925          ProducePod($cgi->param('pod'));          ProducePod($cgi->param('pod'));
926        } elsif ($cgi->param('code')) {
927            # Here the user wants to see the code for one of our scripts.
928            LineNumberize($cgi->param('code'));
929      } elsif ($cgi->param('file')) {      } elsif ($cgi->param('file')) {
930          # Here we have a file request. Process according to the type.          # Here we have a file request. Process according to the type.
931          my $type = $cgi->param('file');          my $type = $cgi->param('file');
# Line 332  Line 947 
947          # Insure the function name is valid.          # Insure the function name is valid.
948          Die("Invalid function name.")          Die("Invalid function name.")
949              if $function =~ /\W/;              if $function =~ /\W/;
950            # Determing the encoding scheme. The default is YAML.
951            my $encoding = $cgi->param('encoding') || 'yaml';
952          # The parameter structure will go in here.          # The parameter structure will go in here.
953          my $args;          my $args;
954          # Start the timer.          # Start the timer.
# Line 342  Line 959 
959          my $sapling;          my $sapling;
960          # Protect from errors.          # Protect from errors.
961          eval {          eval {
962              # Parse the arguments.              # Here we parse the arguments. This is affected by the encoding parameter.
963              $args = YAML::Load($cgi->param('args'));              # Get the argument string.
964                my $argString = $cgi->param('args');
965                if ($encoding eq 'yaml') {
966                    # Parse the arguments using YAML.
967                    $args = YAML::Load($argString);
968                } elsif ($encoding eq 'json') {
969                    # Parse the arguments using JSON.
970                    Trace("Incoming string is:\n$argString") if T(3);
971                    $args = JSON::Any->jsonToObj($argString);
972                } else {
973                    Die("Invalid encoding type $encoding.");
974                }
975          };          };
976          # Check to make sure we got everything.          # Check to make sure we got everything.
977          if ($@) {          if ($@) {
# Line 355  Line 983 
983              # If we have an error, create an error document.              # If we have an error, create an error document.
984              if ($@) {              if ($@) {
985                  SendError($@, "Error detected by service.");                  SendError($@, "Error detected by service.");
986                  Trace("Error encountered by service: $@") if T(2);                  Trace("Error encountered by service: $@") if T(0);
987              } else {              } else {
988                  # No error, so we output the result.                  # No error, so we output the result. Start with an HTML header.
989                  print $cgi->header(-type => 'text/plain');                  print $cgi->header(-type => 'text/plain');
990                  my $string = YAML::Dump($document);                  # The nature of the output depends on the encoding type.
991                    my $string;
992                    if ($encoding eq 'yaml') {
993                        $string = YAML::Dump($document);
994                    } else {
995                        $string = JSON::Any->objToJson($document);
996                    }
997                  print $string;                  print $string;
998                  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);
999              }              }
# Line 462  Line 1096 
1096  }  }
1097    
1098    
1099    =head3 LineNumberize
1100    
1101        ServerThing::LineNumberize($module);
1102    
1103    Output the module line by line with line numbers
1104    
1105    =over 4
1106    
1107    =item module
1108    
1109    Name of the module to line numberized
1110    
1111    =back
1112    
1113    =cut
1114    
1115    sub LineNumberize {
1116        # Get the parameters.
1117        my ($module) = @_;
1118        my $fks_path = "$FIG_Config::fig_disk/dist/releases/current/FigKernelScripts/$module";
1119        # Start the output page.
1120        print CGI::header();
1121        print CGI::start_html(-title => 'Documentation Page',
1122                              -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });
1123        # Protect from errors.
1124        eval {
1125            if (-e $fks_path) {
1126                print "<pre>\n";
1127                my $i = 1;
1128                foreach my $line (`cat $fks_path`) {
1129                    print "$i.\t$line";
1130                    $i++;
1131                }
1132                print "</pre>\n";
1133            } else {
1134                print "File $fks_path not found";
1135            }
1136        };
1137        # Process any error.
1138        if ($@) {
1139            print CGI::blockquote({ class => 'error' }, $@);
1140        }
1141        # Close off the page.
1142        print CGI::end_html();
1143    
1144    }
1145    
1146  =head3 ProducePod  =head3 ProducePod
1147    
1148      ServerThing::ProducePod($module);      ServerThing::ProducePod($module);
# Line 483  Line 1164 
1164      my ($module) = @_;      my ($module) = @_;
1165      # Start the output page.      # Start the output page.
1166      print CGI::header();      print CGI::header();
1167      print CGI::start_html(-title => 'Documentation Page',      print CGI::start_html(-title => "$module Documentation Page",
1168                            -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });                            -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });
1169      # Protect from errors.      # Protect from errors.
1170      eval {      eval {

Legend:
Removed from v.1.30  
changed lines
  Added in v.1.51

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3