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

Annotation of /FigKernelPackages/FIG_CGI.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (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 :     #
20 :     # FIG CGI script utility module.
21 :     #
22 :    
23 :     package FIG_CGI;
24 :    
25 :    
26 :     use strict;
27 :     use FIG;
28 :     use FIG_Config;
29 :     use CGI;
30 :     use Data::Dumper;
31 :     use SproutFIG;
32 :    
33 :     use Tracer;
34 :    
35 :     =head3 init
36 :    
37 :     C<< my($fig, $cgi, $user) = FIG_CGI::init(debug_save => 0, debug_load => 0, print_params => 0); >>
38 :    
39 :     Initialize a FIG and CGI object for use in the CGI script. Depending on the
40 :     CGI parameters passed in, the FIG object will be either an actual FIG object
41 :     (when we are in SEED mode), or a SFXlate object (when we are in Sprout mode).
42 :    
43 :     =over4
44 :     =item debug_save
45 :    
46 :     Set this flag to true if the script should save its parameters to a
47 :     file. (Default filename is the name of the script minus the .cgi
48 :     suffix, placed in /.tmp).
49 :    
50 :     =item debug_load
51 :    
52 :     Set this flag to true if the script should load its parameters from a
53 :     file as saved with debug_save.
54 :    
55 :     =item print_params
56 :    
57 :     Set this flag to true if the script should print its CGI parameters
58 :     before exiting.
59 :    
60 :     =back
61 :    
62 :     =cut
63 :    
64 :     sub init
65 :     {
66 :     my(%args) = @_;
67 :    
68 :     my $cgi = new CGI;
69 :     my $fig = init_fig($cgi);
70 :    
71 :     my $script_name = determine_script_name();
72 :     my $file = "/tmp/${script_name}_parms";
73 :    
74 : olson 1.2 # warn "fig_cgi init $file\n";
75 : olson 1.1
76 :     my $printed_params;
77 :     if ($args{print_params})
78 :     {
79 :     do_print_params($cgi);
80 :     $printed_params++;
81 :     }
82 :    
83 :     if ($args{debug_save})
84 :     {
85 :     do_print_params($cgi) unless $printed_params;
86 :     print "Wrote params to $file<p>\n";
87 :     $cgi = do_debug_save($cgi, $file);
88 :     }
89 :     elsif ($args{debug_load})
90 :     {
91 :     $cgi = do_debug_load($cgi, $file);
92 :     }
93 :    
94 :     my $user = $cgi->param('user');
95 :    
96 :    
97 :     return($fig, $cgi, $user);
98 :     }
99 :    
100 :     sub init_tracing
101 :     {
102 :     my($cgi) = @_;
103 :     my $traceData = $cgi->param('trace');
104 :     if ($traceData) {
105 :     TSetup($traceData, "QUEUE");
106 :     $traceData = 1;
107 :     } else {
108 :     TSetup(0, "NONE");
109 :     $traceData = 0;
110 :     }
111 :     }
112 :    
113 :     sub init_fig
114 :     {
115 :     my($cgi) = @_;
116 :    
117 :     my $fig;
118 :     if ($cgi->param('SPROUT'))
119 :     {
120 :     $fig = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
121 :     }
122 :     else
123 :     {
124 :     $fig = new FIG;
125 :     }
126 :     return $fig;
127 :     }
128 :    
129 :     sub do_print_params
130 :     {
131 :     my($cgi) = @_;
132 :    
133 :     print $cgi->header;
134 :     my @params = $cgi->param;
135 :     print "<pre>\n";
136 :     foreach $_ (@params) {
137 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
138 :     }
139 :     print "</pre>\n";
140 :     }
141 :    
142 :     sub do_debug_load
143 :     {
144 :     my($cgi, $file) = @_;
145 :     my $VAR1;
146 :     if (-f $file)
147 :     {
148 :     eval(&FIG::file_read($file));
149 :     $cgi = $VAR1;
150 :     }
151 :     else
152 :     {
153 :     print $cgi->header;
154 :     print "Attempting debug load, but file $file does not exist\n";
155 :     die "Attempting debug load, but file $file does not exist\n";
156 :     }
157 :    
158 :     return $cgi;
159 :     }
160 :    
161 :     sub do_debug_save
162 :     {
163 :     my($cgi, $file) = @_;
164 :    
165 :     if (open(TMP,">$file")) {
166 :     print TMP &Dumper($cgi);
167 :     close(TMP);
168 : olson 1.2 # warn "Loaded cgi from $file\n";
169 : olson 1.1 }
170 :     else
171 :     {
172 :     print $cgi->header;
173 :     print "Attempting debug load, but file $file does not exist\n";
174 :     warn "Attempting debug load, but file $file does not exist\n";
175 :     }
176 :     exit;
177 :     }
178 :    
179 :     sub determine_script_name
180 :     {
181 :     my $path = $ENV{SCRIPT_NAME};
182 :     my $name;
183 :    
184 :     if ($path eq '')
185 :     {
186 :     #
187 :     # We're probably being invoked from the command line.
188 :     #
189 :    
190 :     $path = $0;
191 :     }
192 :    
193 :     if ($path =~ m,/([^/]+)$,)
194 :     {
195 :     $name = $1;
196 :     }
197 :     else
198 :     {
199 :     $name = $path;
200 :     $name =~ s,/,_,g;
201 :     }
202 :     $name =~ s/\.cgi$//;
203 :     return $name;
204 :     }
205 :    
206 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3