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

Diff of /FigKernelPackages/FIG_CGI.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3, Mon Dec 5 19:06:30 2005 UTC revision 1.6, Wed Nov 29 15:19:19 2006 UTC
# Line 16  Line 16 
16  #  #
17    
18    
19  #  =head1 FIG CGI Script Utility Module
20  # FIG CGI script utility module.  
21  #  This package contains utility methods for initializing and debugging CGI scripts
22    in the FIG framework.
23    
24    =cut
25    
26  package FIG_CGI;  package FIG_CGI;
27    
28        require Exporter;
29        @ISA = ('Exporter');
30        @EXPORT = qw(is_sprout);
31    
32    =head2 Public Methods
33    
34    =cut
35    
36  use strict;  use strict;
37  use FIG;  use FIG;
38    use FIGV;
39  use FIG_Config;  use FIG_Config;
40  use CGI;  use CGI;
41  use Data::Dumper;  use Data::Dumper;
# Line 41  Line 52 
52  (when we are in SEED mode), or a SFXlate object (when we are in Sprout mode).  (when we are in SEED mode), or a SFXlate object (when we are in Sprout mode).
53    
54  =over4  =over4
55    
56  =item debug_save  =item debug_save
57    
58  Set this flag to true if the script should save its parameters to a  Set this flag to true if the script should save its parameters to a
59  file. (Default filename is the name of the script minus the .cgi  file. (Default filename is the name of the script minus the .cgi
60  suffix, placed in /.tmp).  suffix, placed in the /tmp/ directory).
61    
62  =item debug_load  =item debug_load
63    
# Line 57  Line 69 
69  Set this flag to true if the script should print its CGI parameters  Set this flag to true if the script should print its CGI parameters
70  before exiting.  before exiting.
71    
72    =item RETURN
73    
74    Returns a three-tuple. The first element is a FIG or Sprout object. The second
75    is a CGI object describing the environment of the calling script. The third
76    is the name of the current user.
77    
78  =back  =back
79    
80  =cut  =cut
81    
82  sub init  sub init {
83  {      # Get the parameters. The calling syntax uses parameter pairs, so we stash
84        # them in a hash.
85      my(%args) = @_;      my(%args) = @_;
86        # Get the CGI and FIG objects.
87      my $cgi = new CGI;      my $cgi = new CGI;
88      my $fig = init_fig($cgi);      my $fig = init_fig($cgi);
89        # If we're debugging, we need to know which file is to receive the debugging
90        # information.
91      my $script_name = determine_script_name();      my $script_name = determine_script_name();
92      my $file = "/tmp/${script_name}_parms";      my $file = "/tmp/${script_name}_parms";
93    
94      # warn "fig_cgi init $file\n";      # warn "fig_cgi init $file\n";
95    
96        # Check to see if we're supposed to display the parameters. Since "debug_save"
97        # mode also prints the parameters, we remember here whether or not we printed
98        # them so we don't print them twice.
99      my $printed_params;      my $printed_params;
100      if ($args{print_params})      if ($args{print_params})
101      {      {
# Line 80  Line 103 
103          $printed_params++;          $printed_params++;
104      }      }
105    
106        # Check to see if we're supposed to save the parameters to a debug file or
107        # load them from a debug file.
108      if ($args{debug_save})      if ($args{debug_save})
109      {      {
110          do_print_params($cgi) unless $printed_params;          do_print_params($cgi) unless $printed_params;
# Line 90  Line 115 
115      {      {
116          $cgi = do_debug_load($cgi, $file);          $cgi = do_debug_load($cgi, $file);
117      }      }
118        # Now the debugging stuff is done and the $cgi object looks exactly the way we
119        # want it.
120    
121      my $user = $cgi->param('user');      # Get the user's name.
122        my $user = $cgi->param('user') || "";
123    
124      return($fig, $cgi, $user);      return($fig, $cgi, $user);
125  }  }
126    
127    =head3 is_sprout
128    
129    C<< my $flag = is_sprout($object); >>
130    
131    Return TRUE if we are running in Sprout mode, else FALSE.
132    
133    =over 4
134    
135    =item object
136    
137    FIG, SFXlate, or CGI object. If a FIG object is passed in, the result is always
138    FALSE. If an SFXlate object is passed in, the result is always TRUE. If a CGI
139    object is passed in, the value of the C<SPROUT> parameter will be returned.
140    
141    =item RETURN
142    
143    Returns TRUE if we're in Sprout mode, else FALSE.
144    
145    =back
146    
147    =cut
148    
149    sub is_sprout {
150        # Get the parameters.
151        my ($object) = @_;
152        # Declare the return variable.
153        my $retVal = 0;
154        # Check the object type. Note that an unknown object or scalar will
155        # default to FALSE. This includes FIG objects, because we don't
156        # explicity check for them.
157        my $type = ref $object;
158        if ($type eq 'SFXlate') {
159            $retVal = 1;
160        } elsif ($type eq 'CGI') {
161            $retVal = $object->param('SPROUT');
162        }
163        # Return the result.
164        return $retVal;
165    }
166    
167  sub init_tracing  sub init_tracing
168  {  {
169      my($cgi) = @_;      my($cgi) = @_;
# Line 121  Line 188 
188      }      }
189      else      else
190      {      {
191            if (my $job = $cgi->param("48hr_job"))
192            {
193                my $jobdir = "/vol/48-hour/Jobs/$job";
194                my $genome = &FIG::file_head("$jobdir/GENOME_ID");
195                chomp $genome;
196                if ($genome !~ /^\d+\.\d+/)
197                {
198                    die "Cannnot find genome ID for jobdir $jobdir\n";
199                }
200                my $orgdir = "$jobdir/rp/$genome";
201                if (! -d $orgdir)
202                {
203                    die "Cannot find orgdir $orgdir\n";
204                }
205                $fig = new FIGV($orgdir);
206            }
207            else
208            {
209          $fig = new FIG;          $fig = new FIG;
210      }      }
211        }
212      return $fig;      return $fig;
213  }  }
214    

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.6

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3