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

Annotation of /FigKernelPackages/FIG_CGI.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : olson 1.3 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 : parrello 1.7 #
7 : olson 1.3 # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 : parrello 1.7 # Public License.
10 : olson 1.3 #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : olson 1.1
19 : parrello 1.4 =head1 FIG CGI Script Utility Module
20 :    
21 :     This package contains utility methods for initializing and debugging CGI scripts
22 :     in the FIG framework.
23 :    
24 :     =cut
25 : olson 1.1
26 :     package FIG_CGI;
27 :    
28 : parrello 1.4 require Exporter;
29 :     @ISA = ('Exporter');
30 :     @EXPORT = qw(is_sprout);
31 :    
32 :     =head2 Public Methods
33 :    
34 :     =cut
35 : olson 1.1
36 :     use strict;
37 :     use FIG;
38 : olson 1.6 use FIGV;
39 : olson 1.11 use FIGM;
40 : olson 1.1 use FIG_Config;
41 :     use CGI;
42 :     use Data::Dumper;
43 :     use SproutFIG;
44 : parrello 1.10 use FIGRules;
45 : olson 1.1
46 :     use Tracer;
47 :    
48 :     =head3 init
49 :    
50 : parrello 1.7 my($fig, $cgi, $user) = FIG_CGI::init(debug_save => 0, debug_load => 0, print_params => 0);
51 : olson 1.1
52 : parrello 1.7 Initialize a FIG and CGI object for use in the CGI script. Depending on the
53 : olson 1.1 CGI parameters passed in, the FIG object will be either an actual FIG object
54 :     (when we are in SEED mode), or a SFXlate object (when we are in Sprout mode).
55 :    
56 : parrello 1.8 =over 4
57 : parrello 1.4
58 : olson 1.1 =item debug_save
59 :    
60 :     Set this flag to true if the script should save its parameters to a
61 :     file. (Default filename is the name of the script minus the .cgi
62 : parrello 1.4 suffix, placed in the /tmp/ directory).
63 : olson 1.1
64 :     =item debug_load
65 :    
66 :     Set this flag to true if the script should load its parameters from a
67 :     file as saved with debug_save.
68 :    
69 :     =item print_params
70 :    
71 :     Set this flag to true if the script should print its CGI parameters
72 :     before exiting.
73 :    
74 : parrello 1.4 =item RETURN
75 :    
76 :     Returns a three-tuple. The first element is a FIG or Sprout object. The second
77 :     is a CGI object describing the environment of the calling script. The third
78 :     is the name of the current user.
79 :    
80 : olson 1.1 =back
81 :    
82 :     =cut
83 :    
84 : parrello 1.4 sub init {
85 :     # Get the parameters. The calling syntax uses parameter pairs, so we stash
86 :     # them in a hash.
87 :     my (%args) = @_;
88 :     # Get the CGI and FIG objects.
89 : olson 1.1 my $cgi = new CGI;
90 :     my $fig = init_fig($cgi);
91 : parrello 1.9 # Turn on tracing.
92 :     ETracing($cgi);
93 : parrello 1.10 # Log this page if it's a robot.
94 :     FIGRules::LogRobot($cgi);
95 : parrello 1.4 # If we're debugging, we need to know which file is to receive the debugging
96 :     # information.
97 : olson 1.1 my $script_name = determine_script_name();
98 :     my $file = "/tmp/${script_name}_parms";
99 :    
100 : olson 1.2 # warn "fig_cgi init $file\n";
101 : olson 1.1
102 : parrello 1.4 # Check to see if we're supposed to display the parameters. Since "debug_save"
103 :     # mode also prints the parameters, we remember here whether or not we printed
104 :     # them so we don't print them twice.
105 : olson 1.1 my $printed_params;
106 :     if ($args{print_params})
107 :     {
108 : parrello 1.4 do_print_params($cgi);
109 :     $printed_params++;
110 : olson 1.1 }
111 :    
112 : parrello 1.4 # Check to see if we're supposed to save the parameters to a debug file or
113 :     # load them from a debug file.
114 : olson 1.1 if ($args{debug_save})
115 :     {
116 : parrello 1.4 do_print_params($cgi) unless $printed_params;
117 :     print "Wrote params to $file<p>\n";
118 :     $cgi = do_debug_save($cgi, $file);
119 : olson 1.1 }
120 :     elsif ($args{debug_load})
121 :     {
122 : parrello 1.4 $cgi = do_debug_load($cgi, $file);
123 : olson 1.1 }
124 : parrello 1.4 # Now the debugging stuff is done and the $cgi object looks exactly the way we
125 :     # want it.
126 : parrello 1.7
127 : parrello 1.4 # Get the user's name.
128 :     my $user = $cgi->param('user') || "";
129 :    
130 :     return($fig, $cgi, $user);
131 :     }
132 :    
133 :     =head3 is_sprout
134 :    
135 : parrello 1.7 my $flag = is_sprout($object);
136 : parrello 1.4
137 :     Return TRUE if we are running in Sprout mode, else FALSE.
138 :    
139 :     =over 4
140 : olson 1.1
141 : parrello 1.4 =item object
142 : olson 1.1
143 : parrello 1.4 FIG, SFXlate, or CGI object. If a FIG object is passed in, the result is always
144 :     FALSE. If an SFXlate object is passed in, the result is always TRUE. If a CGI
145 :     object is passed in, the value of the C<SPROUT> parameter will be returned.
146 : olson 1.1
147 : parrello 1.4 =item RETURN
148 :    
149 :     Returns TRUE if we're in Sprout mode, else FALSE.
150 :    
151 :     =back
152 :    
153 :     =cut
154 :    
155 :     sub is_sprout {
156 :     # Get the parameters.
157 :     my ($object) = @_;
158 :     # Declare the return variable.
159 :     my $retVal = 0;
160 :     # Check the object type. Note that an unknown object or scalar will
161 :     # default to FALSE. This includes FIG objects, because we don't
162 :     # explicity check for them.
163 :     my $type = ref $object;
164 :     if ($type eq 'SFXlate') {
165 :     $retVal = 1;
166 :     } elsif ($type eq 'CGI') {
167 : parrello 1.9 $retVal = FIGRules::nmpdr_mode($object);
168 : parrello 1.4 }
169 :     # Return the result.
170 :     return $retVal;
171 :     }
172 :    
173 : olson 1.1 sub init_tracing
174 :     {
175 : parrello 1.9 # DEPRECATED: ETracing is used instead.
176 : olson 1.1 }
177 :    
178 :     sub init_fig
179 :     {
180 :     my($cgi) = @_;
181 :    
182 : olson 1.11 my $base_fig;
183 : olson 1.1 my $fig;
184 : parrello 1.9 if (FIGRules::nmpdr_mode($cgi))
185 : olson 1.1 {
186 : olson 1.11 $base_fig = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
187 : olson 1.1 }
188 :     else
189 :     {
190 : olson 1.11 $base_fig = new FIG();
191 :     }
192 :     if (my $job = $cgi->param("48hr_job"))
193 :     {
194 :     my $jobdir = "/vol/48-hour/Jobs/$job";
195 :     my $genome = &FIG::file_head("$jobdir/GENOME_ID");
196 :     chomp $genome;
197 :     if ($genome !~ /^\d+\.\d+/)
198 : olson 1.6 {
199 : olson 1.11 die "Cannnot find genome ID for jobdir $jobdir\n";
200 : olson 1.6 }
201 : olson 1.11 my $orgdir = "$jobdir/rp/$genome";
202 :     if (! -d $orgdir)
203 : olson 1.6 {
204 : olson 1.11 die "Cannot find orgdir $orgdir\n";
205 : olson 1.6 }
206 : olson 1.11 $fig = new FIGV($orgdir, undef, $base_fig);
207 :     }
208 :     elsif (ref($FIG_Config::figm_dirs) eq 'ARRAY')
209 :     {
210 :     warn "Using FIGM @$FIG_Config::figm_dirs\n";
211 :     $fig = new FIGM($base_fig, @{$FIG_Config::figm_dirs});
212 : olson 1.1 }
213 : olson 1.11 else
214 :     {
215 :     $fig = $base_fig;
216 :     }
217 :    
218 : olson 1.1 return $fig;
219 :     }
220 :    
221 :     sub do_print_params
222 :     {
223 :     my($cgi) = @_;
224 : parrello 1.7
225 : olson 1.1 print $cgi->header;
226 :     my @params = $cgi->param;
227 :     print "<pre>\n";
228 :     foreach $_ (@params) {
229 : parrello 1.4 print "$_\t:",join(",",$cgi->param($_)),":\n";
230 : olson 1.1 }
231 :     print "</pre>\n";
232 :     }
233 :    
234 :     sub do_debug_load
235 :     {
236 :     my($cgi, $file) = @_;
237 :     my $VAR1;
238 :     if (-f $file)
239 :     {
240 : parrello 1.4 eval(&FIG::file_read($file));
241 :     $cgi = $VAR1;
242 : olson 1.1 }
243 :     else
244 :     {
245 : parrello 1.4 print $cgi->header;
246 :     print "Attempting debug load, but file $file does not exist\n";
247 :     die "Attempting debug load, but file $file does not exist\n";
248 : olson 1.1 }
249 :    
250 :     return $cgi;
251 :     }
252 :    
253 :     sub do_debug_save
254 :     {
255 :     my($cgi, $file) = @_;
256 :    
257 :     if (open(TMP,">$file")) {
258 : parrello 1.4 print TMP &Dumper($cgi);
259 :     close(TMP);
260 :     # warn "Loaded cgi from $file\n";
261 : olson 1.1 }
262 :     else
263 :     {
264 : parrello 1.4 print $cgi->header;
265 :     print "Attempting debug load, but file $file does not exist\n";
266 :     warn "Attempting debug load, but file $file does not exist\n";
267 : olson 1.1 }
268 :     exit;
269 :     }
270 :    
271 :     sub determine_script_name
272 :     {
273 :     my $path = $ENV{SCRIPT_NAME};
274 :     my $name;
275 : parrello 1.7
276 : olson 1.1 if ($path eq '')
277 :     {
278 : parrello 1.4 #
279 :     # We're probably being invoked from the command line.
280 :     #
281 : olson 1.1
282 : parrello 1.4 $path = $0;
283 : olson 1.1 }
284 :    
285 :     if ($path =~ m,/([^/]+)$,)
286 :     {
287 : parrello 1.4 $name = $1;
288 : olson 1.1 }
289 :     else
290 :     {
291 : parrello 1.4 $name = $path;
292 :     $name =~ s,/,_,g;
293 : olson 1.1 }
294 :     $name =~ s/\.cgi$//;
295 :     return $name;
296 :     }
297 :    
298 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3