[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.51, Wed Apr 28 15:46:38 2010 UTC revision 1.54, Tue Jul 13 18:49:09 2010 UTC
# Line 98  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 118  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 128  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 152  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 853  Line 866 
866      return $retVal;      return $retVal;
867  }  }
868    
869    =head3 GetCorrespondenceData
870    
871        my $corrList = ServerThing::GetCorrespondenceData($genome1, $genome2, $passive, $full);
872    
873    Return the L</Gene Correspondence List> for the specified source and target genomes. If the
874    list is in a file, it will be read. If the file does not exist, it may be created.
875    
876    =over 4
877    
878    =item genome1
879    
880    ID of the source genome.
881    
882    =item genome2
883    
884    ID of the target genome.
885    
886    =item passive
887    
888    If TRUE, then the correspondence file will not be created if it does not exist.
889    
890    =item full
891    
892    If TRUE, then both directions of the correspondence will be represented; otherwise, only
893    correspondences from the source to the target (including bidirectional corresopndences)
894    will be included.
895    
896    =item RETURN
897    
898    Returns a L</Gene Correspondence List> in the form of a reference to a list of lists, or an
899    undefined value if an error occurs or no file exists and passive mode was specified.
900    
901    =back
902    
903    =cut
904    
905    sub GetCorrespondenceData {
906        # Get the parameters.
907        my ($genome1, $genome2, $passive, $full) = @_;
908        # Declare the return variable.
909        my $retVal;
910        # Check for a gene correspondence file.
911        my ($fileName, $converse) = ServerThing::CheckForGeneCorrespondenceFile($genome1, $genome2);
912        if ($fileName) {
913            # Here we found one, so read it in.
914            $retVal = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse, $full);
915        }
916        # Were we successful?
917        if (! defined $retVal) {
918            # Here we either don't have a correspondence file, or the one that's there is
919            # invalid. If we are NOT in passive mode, then this means we need to create
920            # the file.
921            if (! $passive) {
922                ($fileName, $converse) = ServerThing::CreateGeneCorrespondenceFile($genome1, $genome2);
923                # Now try reading the new file.
924                if (defined $fileName) {
925                    $retVal = ServerThing::ReadGeneCorrespondenceFile($fileName, $converse);
926                }
927            }
928        }
929        # Return the result.
930        return $retVal;
931    
932    }
933    
934    
935  =head2 Internal Utility Methods  =head2 Internal Utility Methods
936    
# Line 920  Line 998 
998      # Get the parameters.      # Get the parameters.
999      my ($cgi, $serverThing, $docURL) = @_;      my ($cgi, $serverThing, $docURL) = @_;
1000      # Determine the request type.      # Determine the request type.
1001      if ($cgi->param('pod')) {      my $module = $cgi->param('pod');
1002          # Here we have a documentation request. In this case, we produce POD HTML.      if ($module) {
1003            # Here we have a documentation request.
1004            if ($module eq 'ServerScripts') {
1005                # Here we list the server scripts.
1006                require ListServerScripts;
1007                ListServerScripts::main();
1008            } else {
1009                # In this case, we produce POD HTML.
1010          ProducePod($cgi->param('pod'));          ProducePod($cgi->param('pod'));
1011            }
1012      } elsif ($cgi->param('code')) {      } elsif ($cgi->param('code')) {
1013          # 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.
1014          LineNumberize($cgi->param('code'));          LineNumberize($cgi->param('code'));
# Line 950  Line 1036 
1036          # Determing the encoding scheme. The default is YAML.          # Determing the encoding scheme. The default is YAML.
1037          my $encoding = $cgi->param('encoding') || 'yaml';          my $encoding = $cgi->param('encoding') || 'yaml';
1038          # The parameter structure will go in here.          # The parameter structure will go in here.
1039          my $args;          my $args = {};
1040          # Start the timer.          # Start the timer.
1041          my $start = time();          my $start = time();
1042          # The output document goes in here.          # The output document goes in here.
# Line 962  Line 1048 
1048              # Here we parse the arguments. This is affected by the encoding parameter.              # Here we parse the arguments. This is affected by the encoding parameter.
1049              # Get the argument string.              # Get the argument string.
1050              my $argString = $cgi->param('args');              my $argString = $cgi->param('args');
1051                # Only proceed if we found one.
1052                if ($argString) {
1053              if ($encoding eq 'yaml') {              if ($encoding eq 'yaml') {
1054                  # Parse the arguments using YAML.                  # Parse the arguments using YAML.
1055                  $args = YAML::Load($argString);                  $args = YAML::Load($argString);
# Line 972  Line 1060 
1060              } else {              } else {
1061                  Die("Invalid encoding type $encoding.");                  Die("Invalid encoding type $encoding.");
1062              }              }
1063                }
1064          };          };
1065          # Check to make sure we got everything.          # Check to make sure we got everything.
1066          if ($@) {          if ($@) {

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3