[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.47, Tue Apr 13 20:05:49 2010 UTC revision 1.52, Mon Jun 14 14:36:02 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 97  Line 98 
98    
99  =head3 AddSubsystemFilter  =head3 AddSubsystemFilter
100    
101      ServerThing::AddSubsystemFilter(\$filter, $args);      ServerThing::AddSubsystemFilter(\$filter, $args, $roles);
102    
103  Add subsystem filtering information to the specified query filter clause  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  based on data in the argument hash. The argument hash will be checked for
105  the C<-usable> parameter, which includes or excludes unusuable subsystems, and  the C<-usable> parameter, which includes or excludes unusuable subsystems,
106  the C<-exclude> parameter, which lists types of subsystems that should be  the C<-exclude> parameter, which lists types of subsystems that should be
107  excluded.  excluded, and the C<-aux> parameter, which filters on auxiliary roles.
108    
109  =over 4  =over 4
110    
# Line 117  Line 118 
118  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
119  be examined for the C<-usable> and C<-exclude> parameters.  be examined for the C<-usable> and C<-exclude> parameters.
120    
121    =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  =back  =back
127    
128  =cut  =cut
# Line 127  Line 133 
133    
134  sub AddSubsystemFilter {  sub AddSubsystemFilter {
135      # Get the parameters.      # Get the parameters.
136      my ($filter, $args) = @_;      my ($filter, $args, $roles) = @_;
137      # We'll put the new filter stuff in here.      # We'll put the new filter stuff in here.
138      my @newFilters;      my @newFilters;
139      # 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 157 
157              push @newFilters, "Subsystem($exclusion) = 0";              push @newFilters, "Subsystem($exclusion) = 0";
158          }          }
159      }      }
160        # 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      # Do we need to update the incoming filter?      # Do we need to update the incoming filter?
169      if (@newFilters) {      if (@newFilters) {
170          # 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 868  Line 882 
882    
883  =item cgi  =item cgi
884    
885  CGI query object containing the parameters from the web service request.  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    
924  =item serverThing  =item serverThing
925    
# Line 882  Line 933 
933      # Get the parameters.      # Get the parameters.
934      my ($cgi, $serverThing, $docURL) = @_;      my ($cgi, $serverThing, $docURL) = @_;
935      # Determine the request type.      # Determine the request type.
936      if ($cgi->param('pod')) {      my $module = $cgi->param('pod');
937          # Here we have a documentation request. In this case, we produce POD HTML.      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'));          ProducePod($cgi->param('pod'));
946            }
947      } elsif ($cgi->param('code')) {      } elsif ($cgi->param('code')) {
948          # 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.
949          LineNumberize($cgi->param('code'));          LineNumberize($cgi->param('code'));
# Line 909  Line 968 
968          # Insure the function name is valid.          # Insure the function name is valid.
969          Die("Invalid function name.")          Die("Invalid function name.")
970              if $function =~ /\W/;              if $function =~ /\W/;
971            # Determing the encoding scheme. The default is YAML.
972            my $encoding = $cgi->param('encoding') || 'yaml';
973          # The parameter structure will go in here.          # The parameter structure will go in here.
974          my $args;          my $args;
975          # Start the timer.          # Start the timer.
# Line 919  Line 980 
980          my $sapling;          my $sapling;
981          # Protect from errors.          # Protect from errors.
982          eval {          eval {
983              # Parse the arguments.              # Here we parse the arguments. This is affected by the encoding parameter.
984              $args = YAML::Load($cgi->param('args'));              # 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                    Trace("Incoming string is:\n$argString") if T(3);
992                    $args = JSON::Any->jsonToObj($argString);
993                } else {
994                    Die("Invalid encoding type $encoding.");
995                }
996          };          };
997          # Check to make sure we got everything.          # Check to make sure we got everything.
998          if ($@) {          if ($@) {
# Line 934  Line 1006 
1006                  SendError($@, "Error detected by service.");                  SendError($@, "Error detected by service.");
1007                  Trace("Error encountered by service: $@") if T(0);                  Trace("Error encountered by service: $@") if T(0);
1008              } else {              } else {
1009                  # No error, so we output the result.                  # No error, so we output the result. Start with an HTML header.
1010                  print $cgi->header(-type => 'text/plain');                  print $cgi->header(-type => 'text/plain');
1011                  my $string = YAML::Dump($document);                  # 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                  print $string;                  print $string;
1019                  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);
1020              }              }

Legend:
Removed from v.1.47  
changed lines
  Added in v.1.52

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3