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

Annotation of /FigKernelPackages/FIG_CGI.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3