[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.39, Tue Mar 16 19:50:43 2010 UTC revision 1.61, Wed Jan 26 15:32:08 2011 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 39  Line 40 
40      # Create the server object.      # Create the server object.
41      Trace("Requiring $serverName for task $$.") if T(3);      Trace("Requiring $serverName for task $$.") if T(3);
42      eval {      eval {
43          require "$serverName.pm";          my $output = $serverName;
44            $output =~ s/::/\//;
45            require "$output.pm";
46      };      };
47      # If we have an error, create an error document.      # If we have an error, create an error document.
48      if ($@) {      if ($@) {
# Line 97  Line 100 
100    
101  =head3 AddSubsystemFilter  =head3 AddSubsystemFilter
102    
103      ServerThing::AddSubsystemFilter(\$filter, $args);      ServerThing::AddSubsystemFilter(\$filter, $args, $roles);
104    
105  Add subsystem filtering information to the specified query filter clause  Add subsystem filtering information to the specified query filter clause
106  based on data in the argument hash. The argument hash will be checked for  based on data in the argument hash. The argument hash will be checked for
107  the C<-usable> parameter, which includes or excludes unusuable subsystems, and  the C<-usable> parameter, which includes or excludes unusuable subsystems,
108  the C<-exclude> parameter, which lists types of subsystems that should be  the C<-exclude> parameter, which lists types of subsystems that should be
109  excluded.  excluded, and the C<-aux> parameter, which filters on auxiliary roles.
110    
111  =over 4  =over 4
112    
# Line 117  Line 120 
120  Reference to the parameter hash for the current server call. This hash will  Reference to the parameter hash for the current server call. This hash will
121  be examined for the C<-usable> and C<-exclude> parameters.  be examined for the C<-usable> and C<-exclude> parameters.
122    
123    =item roles
124    
125    If TRUE, role filtering will be applied. In this case, the default action
126    is to exclude auxiliary roles unless C<-aux> is TRUE.
127    
128  =back  =back
129    
130  =cut  =cut
# Line 127  Line 135 
135    
136  sub AddSubsystemFilter {  sub AddSubsystemFilter {
137      # Get the parameters.      # Get the parameters.
138      my ($filter, $args) = @_;      my ($filter, $args, $roles) = @_;
139      # We'll put the new filter stuff in here.      # We'll put the new filter stuff in here.
140      my @newFilters;      my @newFilters;
141      # Unless unusable subsystems are desired, we must add a clause to the filter.      # Unless unusable subsystems are desired, we must add a clause to the filter.
# Line 151  Line 159 
159              push @newFilters, "Subsystem($exclusion) = 0";              push @newFilters, "Subsystem($exclusion) = 0";
160          }          }
161      }      }
162        # Check for role filtering.
163        if ($roles) {
164            # Here, we filter out auxiliary roles unless the user requests
165            # them.
166            if (! $args->{-aux}) {
167                push @newFilters, "Includes(auxiliary) = 0"
168            }
169        }
170      # Do we need to update the incoming filter?      # Do we need to update the incoming filter?
171      if (@newFilters) {      if (@newFilters) {
172          # Yes. If the incoming filter is nonempty, push it onto the list          # Yes. If the incoming filter is nonempty, push it onto the list
# Line 291  Line 307 
307      }      }
308  }  }
309    
310    =head3 ReadCountVector
311    
312        my $vector = ServerThing::ReadCountVector($qh, $field, $rawFlag);
313    
314    Extract a count vector from a query. The query can contain zero or more results,
315    and the vectors in the specified result field of the query must be concatenated
316    together in order. This method is optimized for the case (expected to be most
317    common) where there is only one result.
318    
319    =over 4
320    
321    =item qh
322    
323    Handle for the query from which results are to be extracted.
324    
325    =item field
326    
327    Name of the field containing the count vectors.
328    
329    =item rawFlag
330    
331    TRUE if the vector is to be returned as a raw string, FALSE if it is to be returned
332    as reference to a list of numbers.
333    
334    =item RETURN
335    
336    Returns the desired vector, either encoded as a string or as a reference to a list
337    of numbers.
338    
339    =back
340    
341    =cut
342    
343    sub ReadCountVector {
344        # Get the parameters.
345        my ($qh, $field, $rawFlag) = @_;
346        # Declare the return variable.
347        my $retVal;
348        # Loop through the query results.
349        while (my $resultRow = $qh->Fetch()) {
350            # Get this vector.
351            my ($levelVector) = $resultRow->Value($field, $rawFlag);
352            # Is this the first result?
353            if (! defined $retVal) {
354                # Yes. Assign the result directly.
355                $retVal = $levelVector;
356            } elsif ($rawFlag) {
357                # This is a second result and the vectors are coded as strings.
358                $retVal .= $levelVector;
359            } else {
360                # This is a second result and the vectors are coded as array references.
361                push @$retVal, @$levelVector;
362            }
363        }
364        # Return the result.
365        return $retVal;
366    }
367    
368    =head3 ChangeDB
369    
370        ServerThing::ChangeDB($thing, $newDbName);
371    
372    Change the sapling database used by this server. The old database will be closed and a
373    new one attached.
374    
375    =over 4
376    
377    =item newDbName
378    
379    Name of the new Sapling database on which this server should operate. If omitted, the
380    default database will be used.
381    
382    =back
383    
384    =cut
385    
386    sub ChangeDB {
387        # Get the parameters.
388        my ($thing, $newDbName) = @_;
389        # Default the db-name if it's not specified.
390        if (! defined $newDbName) {
391            $newDbName = $FIG_Config::saplingDB;
392        }
393        # Check to see if we really need to change.
394        my $oldDB = $thing->{db};
395        if (! defined $oldDB || $oldDB->dbName() ne $newDbName) {
396            # We need a new sapling.
397            require Sapling;
398            my $newDB = Sapling->new(dbName => $newDbName);
399            $thing->{db} = $newDB;
400        }
401    }
402    
403    
404  =head2 Gene Correspondence File Methods  =head2 Gene Correspondence File Methods
405    
# Line 468  Line 577 
577      my $testFileName = "$FIG_Config::organisms/$genomeA/CorrToReferenceGenomes/$genomeB";      my $testFileName = "$FIG_Config::organisms/$genomeA/CorrToReferenceGenomes/$genomeB";
578      if (0 && -f $testFileName) {      if (0 && -f $testFileName) {
579          # Use the pre-computed file.          # Use the pre-computed file.
580          Trace("Using pre-computed file $fileName for genome correspondence.") if T(3);          Trace("Using pre-computed file $fileName for genome correspondence.") if T(Corr => 3);
581          $fileName = $testFileName;          $fileName = $testFileName;
582      } elsif (-f $corrFileName) {      } elsif (-f $corrFileName) {
583          $fileName = $corrFileName;          $fileName = $corrFileName;
584          Trace("Using cached file $fileName for genome correspondence.") if T(3);          Trace("Using cached file $fileName for genome correspondence.") if T(Corr => 3);
585      }      }
586      # Return the result.      # Return the result.
587      return ($fileName, $converse);      return ($fileName, $converse);
# Line 513  Line 622 
622      # Declare the return variables.      # Declare the return variables.
623      my ($fileName, $genomeA, $genomeB);      my ($fileName, $genomeA, $genomeB);
624      # Determine the ordering of the genome IDs.      # Determine the ordering of the genome IDs.
625      if ($genome1 lt $genome2) {      if (MustFlipGenomeIDs($genome1, $genome2)) {
         ($genomeA, $genomeB) = ($genome1, $genome2);  
     } else {  
626          ($genomeA, $genomeB) = ($genome2, $genome1);          ($genomeA, $genomeB) = ($genome2, $genome1);
627        } else {
628            ($genomeA, $genomeB) = ($genome1, $genome2);
629      }      }
630      # Insure the source organism has a subdirectory in the organism cache.      # Insure the source organism has a subdirectory in the organism cache.
631      my $orgDir = "$FIG_Config::orgCache/$genomeA";      my $orgDir = ComputeCorrespondenceDirectory($genomeA);
     Tracer::Insure($orgDir, 0777);  
632      # Compute the name of the correspondence file for the appropriate target genome.      # Compute the name of the correspondence file for the appropriate target genome.
633      $fileName = "$orgDir/$genomeB";      $fileName = "$orgDir/$genomeB";
634      # Return the results.      # Return the results.
# Line 528  Line 636 
636  }  }
637    
638    
639    =head3 ComputeCorresopndenceDirectory
640    
641        my $dirName = ServerThing::ComputeCorrespondenceDirectory($genome);
642    
643    Return the name of the directory that would contain the correspondence files
644    for the specified genome.
645    
646    =over 4
647    
648    =item genome
649    
650    ID of the genome whose correspondence file directory is desired.
651    
652    =item RETURN
653    
654    Returns the name of the directory of interest.
655    
656    =back
657    
658    =cut
659    
660    sub ComputeCorrespondenceDirectory {
661        # Get the parameters.
662        my ($genome) = @_;
663        # Insure the source organism has a subdirectory in the organism cache.
664        my $retVal = "$FIG_Config::orgCache/$genome";
665        Tracer::Insure($retVal, 0777);
666        # Return it.
667        return $retVal;
668    }
669    
670    
671  =head3 CreateGeneCorrespondenceFile  =head3 CreateGeneCorrespondenceFile
672    
673      my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);      my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);
# Line 599  Line 739 
739              # Everything is ok, fix the permissions and return the file name.              # Everything is ok, fix the permissions and return the file name.
740              chmod 0664, $corrFileName;              chmod 0664, $corrFileName;
741              $fileName = $corrFileName;              $fileName = $corrFileName;
742              Trace("Created correspondence file $fileName.") if T(3);              Trace("Created correspondence file $fileName.") if T(Corr => 3);
743          }          }
744      }      }
745      # If the temporary file exists, delete it.      # If the temporary file exists, delete it.
# Line 611  Line 751 
751  }  }
752    
753    
754    =head3 MustFlipGenomeIDs
755    
756        my $converse = ServerThing::MustFlipGenomeIDs($genome1, $genome2);
757    
758    Return TRUE if the specified genome IDs are out of order. When genome IDs are out of
759    order, they are stored in the converse order in correspondence files on the server.
760    This is a simple method that allows the caller to check for the need to flip.
761    
762    =over 4
763    
764    =item genome1
765    
766    ID of the proposed source genome.
767    
768    =item genome2
769    
770    ID of the proposed target genome.
771    
772    =item RETURN
773    
774    Returns TRUE if the first genome would be stored on the server as a target, FALSE if
775    it would be stored as a source.
776    
777    =back
778    
779    =cut
780    
781    sub MustFlipGenomeIDs {
782        # Get the parameters.
783        my ($genome1, $genome2) = @_;
784        # Return an indication.
785        return ($genome1 gt $genome2);
786    }
787    
788    
789  =head3 ReadGeneCorrespondenceFile  =head3 ReadGeneCorrespondenceFile
790    
791      my $list = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse);      my $list = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse, $all);
792    
793  Return the contents of the specified gene correspondence file in the form of  Return the contents of the specified gene correspondence file in the form of
794  a list of lists, with backward correspondences filtered out. If the file is  a list of lists, with backward correspondences filtered out. If the file is
# Line 633  Line 808 
808  If TRUE, the file columns will be reorderd automatically. The default is FALSE,  If TRUE, the file columns will be reorderd automatically. The default is FALSE,
809  meaning we want to use the file as it appears on disk.  meaning we want to use the file as it appears on disk.
810    
811    =item all (optional)
812    
813    TRUE if backward unidirectional correspondences should be included in the output.
814    The default is FALSE, in which case only forward and bidirectional correspondences
815    are included.
816    
817  =item RETURN  =item RETURN
818    
819  Returns a L</Gene Correspondence List> in the form of a reference to a list of lists.  Returns a L</Gene Correspondence List> in the form of a reference to a list of lists.
# Line 645  Line 826 
826    
827  sub ReadGeneCorrespondenceFile {  sub ReadGeneCorrespondenceFile {
828      # Get the parameters.      # Get the parameters.
829      my ($fileName, $converse) = @_;      my ($fileName, $converse, $all) = @_;
830      # Declare the return variable. We will only put something in here if we are      # Declare the return variable. We will only put something in here if we are
831      # completely successful.      # completely successful.
832      my $retVal;      my $retVal;
# Line 656  Line 837 
837      Trace("Reading correspondence file $fileName.") if T(3);      Trace("Reading correspondence file $fileName.") if T(3);
838      if (! open $ih, "<$fileName") {      if (! open $ih, "<$fileName") {
839          # Here the open failed, so we have an error.          # Here the open failed, so we have an error.
840          Trace("Failed to open gene correspondence file $fileName: $!") if T(3);          Trace("Failed to open gene correspondence file $fileName: $!") if T(Corr => 1);
841          $error = 1;          $error = 1;
842      }      }
843      # The gene correspondence list will be built in here.      # The gene correspondence list will be built in here.
# Line 677  Line 858 
858          }          }
859          # Validate the row.          # Validate the row.
860          if (ValidateGeneCorrespondenceRow(\@row)) {          if (ValidateGeneCorrespondenceRow(\@row)) {
861              Trace("Invalid row $. found in correspondence file $fileName.") if T(3);              Trace("Invalid row $. found in correspondence file $fileName.") if T(Corr => 1);
862              $error = 1;              $error = 1;
863          }          }
864          # If this row is in the correct direction, keep it.          # If this row is in the correct direction, keep it.
865          if ($row[8] ne '<-') {          if ($all || $row[8] ne '<-') {
866              push @corrList, \@row;              push @corrList, \@row;
867          }          }
868      }      }
869      # Close the input file.      # Close the input file.
870      close $ih;      close $ih;
871      # If we have no errors and we found a reverse arrow, keep the result.      # If we have no errors, keep the result.
872      if (! $error) {      if (! $error) {
         if ($reverseFound) {  
873              $retVal = \@corrList;              $retVal = \@corrList;
         } else {  
             Trace("No reverse arrow found in correspondence file $fileName.") if T(3);  
         }  
874      }      }
875      # Return the result (if any).      # Return the result (if any).
876      return $retVal;      return $retVal;
# Line 722  Line 899 
899      my ($row) = @_;      my ($row) = @_;
900      # Flip the row in place.      # Flip the row in place.
901      ($row->[1], $row->[0], $row->[2], $row->[3], $row->[5], $row->[4], $row->[7],      ($row->[1], $row->[0], $row->[2], $row->[3], $row->[5], $row->[4], $row->[7],
902       $row->[6], ARROW_FLIP->{$row->[8]}, $row->[9], $row->[10], $row->[14],       $row->[6], $row->[8], $row->[9], $row->[10], $row->[14],
903       $row->[15], $row->[16], $row->[11], $row->[12], $row->[13], $row->[17]) = @$row;       $row->[15], $row->[16], $row->[11], $row->[12], $row->[13], $row->[17]) = @$row;
904        # Flip the arrow.
905        $row->[8] = ARROW_FLIP->{$row->[8]};
906        # Flip the pairs.
907        my @elements = split /,/, $row->[3];
908        $row->[3] = join(",", map { join(":", reverse split /:/, $_) } @elements);
909  }  }
910    
911  =head3 ValidateGeneCorrespondenceRow  =head3 ValidateGeneCorrespondenceRow
# Line 757  Line 939 
939      # Check for non-numeric values in the number columns.      # Check for non-numeric values in the number columns.
940      for my $col (@{NUM_COLS()}) {      for my $col (@{NUM_COLS()}) {
941          unless ($row->[$col] =~ /^-?\d+\.?\d*(?:e[+-]?\d+)?$/) {          unless ($row->[$col] =~ /^-?\d+\.?\d*(?:e[+-]?\d+)?$/) {
942                Trace("Gene correspondence error. \"$row->[$col]\" not numeric.") if T(Corr => 2);
943              $retVal++;              $retVal++;
944          }          }
945      }      }
946      # Check the gene IDs.      # Check the gene IDs.
947      for my $col (0, 1) {      for my $col (0, 1) {
948          unless ($row->[$col] =~ /^fig\|\d+\.\d+\.\w+\.\d+$/) {          unless ($row->[$col] =~ /^fig\|\d+\.\d+\.\w+\.\d+$/) {
949                Trace("Gene correspondence error. \"$row->[$col]\" not a gene ID.") if T(Corr => 2);
950              $retVal++;              $retVal++;
951          }          }
952      }      }
953      # Verify the arrow.      # Verify the arrow.
954      unless (exists ARROW_FLIP->{$row->[8]}) {      unless (exists ARROW_FLIP->{$row->[8]}) {
955            Trace("Gene correspondence error. \"$row->[8]\" not an arrow.") if T(Corr => 2);
956          $retVal++;          $retVal++;
957      }      }
958      # Return the error count.      # Return the error count.
959      return $retVal;      return $retVal;
960  }  }
961    
962    =head3 GetCorrespondenceData
963    
964        my $corrList = ServerThing::GetCorrespondenceData($genome1, $genome2, $passive, $full);
965    
966    Return the L</Gene Correspondence List> for the specified source and target genomes. If the
967    list is in a file, it will be read. If the file does not exist, it may be created.
968    
969    =over 4
970    
971    =item genome1
972    
973    ID of the source genome.
974    
975    =item genome2
976    
977    ID of the target genome.
978    
979    =item passive
980    
981    If TRUE, then the correspondence file will not be created if it does not exist.
982    
983    =item full
984    
985    If TRUE, then both directions of the correspondence will be represented; otherwise, only
986    correspondences from the source to the target (including bidirectional corresopndences)
987    will be included.
988    
989    =item RETURN
990    
991    Returns a L</Gene Correspondence List> in the form of a reference to a list of lists, or an
992    undefined value if an error occurs or no file exists and passive mode was specified.
993    
994    =back
995    
996    =cut
997    
998    sub GetCorrespondenceData {
999        # Get the parameters.
1000        my ($genome1, $genome2, $passive, $full) = @_;
1001        # Declare the return variable.
1002        my $retVal;
1003        # Check for a gene correspondence file.
1004        my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);
1005        if ($fileName) {
1006            # Here we found one, so read it in.
1007            $retVal = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse, $full);
1008        }
1009        # Were we successful?
1010        if (! defined $retVal) {
1011            # Here we either don't have a correspondence file, or the one that's there is
1012            # invalid. If we are NOT in passive mode, then this means we need to create
1013            # the file.
1014            if (! $passive) {
1015                ($fileName, $converse) = ServerThing::CreateGeneCorrespondenceFile($genome1, $genome2);
1016                # Now try reading the new file.
1017                if (defined $fileName) {
1018                    $retVal = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse);
1019                }
1020            }
1021        }
1022        # Return the result.
1023        return $retVal;
1024    
1025    }
1026    
1027    
1028  =head2 Internal Utility Methods  =head2 Internal Utility Methods
1029    
# Line 790  Line 1040 
1040    
1041  =item cgi  =item cgi
1042    
1043  CGI query object containing the parameters from the web service request.  CGI query object containing the parameters from the web service request. The
1044    significant parameters are as follows.
1045    
1046    =over 8
1047    
1048    =item function
1049    
1050    Name of the function to run.
1051    
1052    =item args
1053    
1054    Parameters for the function.
1055    
1056    =item encoding
1057    
1058    Encoding scheme for the function parameters, either C<yaml> (the default) or C<json> (used
1059    by the Java interface).
1060    
1061    =back
1062    
1063    Certain unusual requests can come in outside of the standard function interface.
1064    These are indicated by special parameters that override all the others.
1065    
1066    =over 8
1067    
1068    =item pod
1069    
1070    Display a POD documentation module.
1071    
1072    =item code
1073    
1074    Display an example code file.
1075    
1076    =item file
1077    
1078    Transfer a file (not implemented).
1079    
1080    =back
1081    
1082  =item serverThing  =item serverThing
1083    
# Line 804  Line 1091 
1091      # Get the parameters.      # Get the parameters.
1092      my ($cgi, $serverThing, $docURL) = @_;      my ($cgi, $serverThing, $docURL) = @_;
1093      # Determine the request type.      # Determine the request type.
1094      if ($cgi->param('pod')) {      my $module = $cgi->param('pod');
1095          # Here we have a documentation request. In this case, we produce POD HTML.      if ($module) {
1096            # Here we have a documentation request.
1097            if ($module eq 'ServerScripts') {
1098                # Here we list the server scripts.
1099                require ListServerScripts;
1100                ListServerScripts::main();
1101            } else {
1102                # In this case, we produce POD HTML.
1103          ProducePod($cgi->param('pod'));          ProducePod($cgi->param('pod'));
1104            }
1105      } elsif ($cgi->param('code')) {      } elsif ($cgi->param('code')) {
1106          # Here the user wants to see the code for one of our scripts.          # Here the user wants to see the code for one of our scripts.
1107          LineNumberize($cgi->param('code'));          LineNumberize($cgi->param('code'));
# Line 831  Line 1126 
1126          # Insure the function name is valid.          # Insure the function name is valid.
1127          Die("Invalid function name.")          Die("Invalid function name.")
1128              if $function =~ /\W/;              if $function =~ /\W/;
1129            # Determing the encoding scheme. The default is YAML.
1130            my $encoding = $cgi->param('encoding') || 'yaml';
1131            # Optional callback for json encoded documents
1132            my $callback = $cgi->param('callback');
1133          # The parameter structure will go in here.          # The parameter structure will go in here.
1134          my $args;          my $args = {};
1135          # Start the timer.          # Start the timer.
1136          my $start = time();          my $start = time();
1137          # The output document goes in here.          # The output document goes in here.
1138          my $document;          my $document;
         # The sapling database goes in here.  
         my $sapling;  
1139          # Protect from errors.          # Protect from errors.
1140          eval {          eval {
1141              # Parse the arguments.              # Here we parse the arguments. This is affected by the encoding parameter.
1142              $args = YAML::Load($cgi->param('args'));              # Get the argument string.
1143                my $argString = $cgi->param('args');
1144                # Only proceed if we found one.
1145                if ($argString) {
1146                    if ($encoding eq 'yaml') {
1147                        # Parse the arguments using YAML.
1148                        $args = YAML::Load($argString);
1149                    } elsif ($encoding eq 'json') {
1150                        # Parse the arguments using JSON.
1151                        Trace("Incoming string is:\n$argString") if T(3);
1152                        $args = JSON::Any->jsonToObj($argString);
1153                    } else {
1154                        Die("Invalid encoding type $encoding.");
1155                    }
1156                }
1157          };          };
1158          # Check to make sure we got everything.          # Check to make sure we got everything.
1159          if ($@) {          if ($@) {
# Line 850  Line 1161 
1161          } elsif (! $function) {          } elsif (! $function) {
1162              SendError("No function specified.", "No function specified.");              SendError("No function specified.", "No function specified.");
1163          } else {          } else {
1164                # Insure we're connected to the correct database.
1165                my $dbName = $cgi->param('dbName');
1166                if ($dbName && exists $serverThing->{db}) {
1167                    ChangeDB($serverThing, $dbName);
1168                }
1169                # Run the request.
1170              $document = eval { $serverThing->$function($args) };              $document = eval { $serverThing->$function($args) };
1171              # If we have an error, create an error document.              # If we have an error, create an error document.
1172              if ($@) {              if ($@) {
1173                  SendError($@, "Error detected by service.");                  SendError($@, "Error detected by service.");
1174                  Trace("Error encountered by service: $@") if T(0);                  Trace("Error encountered by service: $@") if T(0);
1175              } else {              } else {
1176                  # No error, so we output the result.                  # No error, so we output the result. Start with an HTML header.
1177                    if ($encoding eq 'yaml') {
1178                  print $cgi->header(-type => 'text/plain');                  print $cgi->header(-type => 'text/plain');
1179                  my $string = YAML::Dump($document);                  } else {
1180                        print $cgi->header(-type => 'text/javascript');
1181                    }
1182                    # The nature of the output depends on the encoding type.
1183                    my $string;
1184                    if ($encoding eq 'yaml') {
1185                        $string = YAML::Dump($document);
1186                    } elsif(defined($callback)) {
1187                        $string = $callback . "(".JSON::Any->objToJson($document).")";
1188                    } else {
1189                        $string = JSON::Any->objToJson($document);
1190                    }
1191                  print $string;                  print $string;
1192                  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);
1193              }              }
# Line 1029  Line 1358 
1358      my ($module) = @_;      my ($module) = @_;
1359      # Start the output page.      # Start the output page.
1360      print CGI::header();      print CGI::header();
1361      print CGI::start_html(-title => 'Documentation Page',      print CGI::start_html(-title => "$module Documentation Page",
1362                            -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });                            -style => { src => "http://servers.nmpdr.org/sapling/Html/css/ERDB.css" });
1363      # Protect from errors.      # Protect from errors.
1364      eval {      eval {

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3