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

Annotation of /FigKernelPackages/FIG_CGI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (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 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
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 :     use FIG_Config;
39 :     use CGI;
40 :     use Data::Dumper;
41 :     use SproutFIG;
42 :    
43 :     use Tracer;
44 :    
45 :     =head3 init
46 :    
47 :     C<< my($fig, $cgi, $user) = FIG_CGI::init(debug_save => 0, debug_load => 0, print_params => 0); >>
48 :    
49 :     Initialize a FIG and CGI object for use in the CGI script. Depending on the
50 :     CGI parameters passed in, the FIG object will be either an actual FIG object
51 :     (when we are in SEED mode), or a SFXlate object (when we are in Sprout mode).
52 :    
53 :     =over4
54 : parrello 1.4
55 : olson 1.1 =item debug_save
56 :    
57 :     Set this flag to true if the script should save its parameters to a
58 :     file. (Default filename is the name of the script minus the .cgi
59 : parrello 1.4 suffix, placed in the /tmp/ directory).
60 : olson 1.1
61 :     =item debug_load
62 :    
63 :     Set this flag to true if the script should load its parameters from a
64 :     file as saved with debug_save.
65 :    
66 :     =item print_params
67 :    
68 :     Set this flag to true if the script should print its CGI parameters
69 :     before exiting.
70 :    
71 : parrello 1.4 =item RETURN
72 :    
73 :     Returns a three-tuple. The first element is a FIG or Sprout object. The second
74 :     is a CGI object describing the environment of the calling script. The third
75 :     is the name of the current user.
76 :    
77 : olson 1.1 =back
78 :    
79 :     =cut
80 :    
81 : parrello 1.4 sub init {
82 :     # Get the parameters. The calling syntax uses parameter pairs, so we stash
83 :     # them in a hash.
84 :     my (%args) = @_;
85 :     # Get the CGI and FIG objects.
86 : olson 1.1 my $cgi = new CGI;
87 :     my $fig = init_fig($cgi);
88 : parrello 1.4 # If we're debugging, we need to know which file is to receive the debugging
89 :     # information.
90 : olson 1.1 my $script_name = determine_script_name();
91 :     my $file = "/tmp/${script_name}_parms";
92 :    
93 : olson 1.2 # warn "fig_cgi init $file\n";
94 : olson 1.1
95 : parrello 1.4 # Check to see if we're supposed to display the parameters. Since "debug_save"
96 :     # mode also prints the parameters, we remember here whether or not we printed
97 :     # them so we don't print them twice.
98 : olson 1.1 my $printed_params;
99 :     if ($args{print_params})
100 :     {
101 : parrello 1.4 do_print_params($cgi);
102 :     $printed_params++;
103 : olson 1.1 }
104 :    
105 : parrello 1.4 # Check to see if we're supposed to save the parameters to a debug file or
106 :     # load them from a debug file.
107 : olson 1.1 if ($args{debug_save})
108 :     {
109 : parrello 1.4 do_print_params($cgi) unless $printed_params;
110 :     print "Wrote params to $file<p>\n";
111 :     $cgi = do_debug_save($cgi, $file);
112 : olson 1.1 }
113 :     elsif ($args{debug_load})
114 :     {
115 : parrello 1.4 $cgi = do_debug_load($cgi, $file);
116 : olson 1.1 }
117 : parrello 1.4 # Now the debugging stuff is done and the $cgi object looks exactly the way we
118 :     # want it.
119 :    
120 :     # Get the user's name.
121 :     my $user = $cgi->param('user') || "";
122 :    
123 :     return($fig, $cgi, $user);
124 :     }
125 :    
126 :     =head3 is_sprout
127 :    
128 :     C<< my $flag = is_sprout($object); >>
129 :    
130 :     Return TRUE if we are running in Sprout mode, else FALSE.
131 :    
132 :     =over 4
133 : olson 1.1
134 : parrello 1.4 =item object
135 : olson 1.1
136 : parrello 1.4 FIG, SFXlate, or CGI object. If a FIG object is passed in, the result is always
137 :     FALSE. If an SFXlate object is passed in, the result is always TRUE. If a CGI
138 :     object is passed in, the value of the C<SPROUT> parameter will be returned.
139 : olson 1.1
140 : parrello 1.4 =item RETURN
141 :    
142 :     Returns TRUE if we're in Sprout mode, else FALSE.
143 :    
144 :     =back
145 :    
146 :     =cut
147 :    
148 :     sub is_sprout {
149 :     # Get the parameters.
150 :     my ($object) = @_;
151 :     # Declare the return variable.
152 :     my $retVal = 0;
153 :     # Check the object type. Note that an unknown object or scalar will
154 :     # default to FALSE. This includes FIG objects, because we don't
155 :     # explicity check for them.
156 :     my $type = ref $object;
157 :     if ($type eq 'SFXlate') {
158 :     $retVal = 1;
159 :     } elsif ($type eq 'CGI') {
160 :     $retVal = $object->param('SPROUT');
161 :     }
162 :     # Return the result.
163 :     return $retVal;
164 :     }
165 :    
166 :     =head3 init_tracing
167 :    
168 :     C<< FIG_CGI::init_tracing($cgi); >>
169 :    
170 :     Set up tracing. Tracing will be
171 :    
172 :     =over 4
173 :    
174 :     TODO: items
175 :    
176 :     =back
177 :    
178 :     =cut
179 :    
180 :     sub init_tracing {
181 :     # Get the parameters.
182 :     my ($cgi) = @_;
183 :     # Declare the return variable.
184 :     my $retVal;
185 :     # TODO: code
186 :     # Return the result.
187 :     return $retVal;
188 : olson 1.1 }
189 :    
190 :     sub init_tracing
191 :     {
192 :     my($cgi) = @_;
193 :     my $traceData = $cgi->param('trace');
194 :     if ($traceData) {
195 : parrello 1.4 TSetup($traceData, "QUEUE");
196 :     $traceData = 1;
197 : olson 1.1 } else {
198 : parrello 1.4 TSetup(0, "NONE");
199 :     $traceData = 0;
200 : olson 1.1 }
201 :     }
202 :    
203 :     sub init_fig
204 :     {
205 :     my($cgi) = @_;
206 :    
207 :     my $fig;
208 :     if ($cgi->param('SPROUT'))
209 :     {
210 : parrello 1.4 $fig = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
211 : olson 1.1 }
212 :     else
213 :     {
214 : parrello 1.4 $fig = new FIG;
215 : olson 1.1 }
216 :     return $fig;
217 :     }
218 :    
219 :     sub do_print_params
220 :     {
221 :     my($cgi) = @_;
222 : parrello 1.4
223 : olson 1.1 print $cgi->header;
224 :     my @params = $cgi->param;
225 :     print "<pre>\n";
226 :     foreach $_ (@params) {
227 : parrello 1.4 print "$_\t:",join(",",$cgi->param($_)),":\n";
228 : olson 1.1 }
229 :     print "</pre>\n";
230 :     }
231 :    
232 :     sub do_debug_load
233 :     {
234 :     my($cgi, $file) = @_;
235 :     my $VAR1;
236 :     if (-f $file)
237 :     {
238 : parrello 1.4 eval(&FIG::file_read($file));
239 :     $cgi = $VAR1;
240 : olson 1.1 }
241 :     else
242 :     {
243 : parrello 1.4 print $cgi->header;
244 :     print "Attempting debug load, but file $file does not exist\n";
245 :     die "Attempting debug load, but file $file does not exist\n";
246 : olson 1.1 }
247 :    
248 :     return $cgi;
249 :     }
250 :    
251 :     sub do_debug_save
252 :     {
253 :     my($cgi, $file) = @_;
254 :    
255 :     if (open(TMP,">$file")) {
256 : parrello 1.4 print TMP &Dumper($cgi);
257 :     close(TMP);
258 :     # warn "Loaded cgi from $file\n";
259 : olson 1.1 }
260 :     else
261 :     {
262 : parrello 1.4 print $cgi->header;
263 :     print "Attempting debug load, but file $file does not exist\n";
264 :     warn "Attempting debug load, but file $file does not exist\n";
265 : olson 1.1 }
266 :     exit;
267 :     }
268 :    
269 :     sub determine_script_name
270 :     {
271 :     my $path = $ENV{SCRIPT_NAME};
272 :     my $name;
273 :    
274 :     if ($path eq '')
275 :     {
276 : parrello 1.4 #
277 :     # We're probably being invoked from the command line.
278 :     #
279 : olson 1.1
280 : parrello 1.4 $path = $0;
281 : olson 1.1 }
282 :    
283 :     if ($path =~ m,/([^/]+)$,)
284 :     {
285 : parrello 1.4 $name = $1;
286 : olson 1.1 }
287 :     else
288 :     {
289 : parrello 1.4 $name = $path;
290 :     $name =~ s,/,_,g;
291 : olson 1.1 }
292 :     $name =~ s/\.cgi$//;
293 :     return $name;
294 :     }
295 :    
296 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3