[Bio] / FigWebServices / bad_roles.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/bad_roles.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : overbeek 1.1 use CGI;
2 :    
3 :    
4 :     if (-f "$FIG_Config::data/Global/why_down")
5 :     {
6 :     local $/;
7 :     open my $fh, "<$FIG_Config::data/Global/why_down";
8 :     my $down_msg = <$fh>;
9 :    
10 :     print CGI::header();
11 :     print CGI::head(CGI::title("SEED Server down"));
12 :     print CGI::start_body();
13 :     print CGI::h1("SEED Server down");
14 :     print CGI::p("The seed server is not currently running:");
15 :     print CGI::pre($down_msg);
16 :     print CGI::end_body();
17 :     exit;
18 :     }
19 :    
20 :     if ($FIG_Config::readonly)
21 :     {
22 :     CGI::param("user", undef);
23 :     }
24 :     # -*- perl -*-
25 :     #
26 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
27 :     # for Interpretations of Genomes. All Rights Reserved.
28 :     #
29 :     # This file is part of the SEED Toolkit.
30 :     #
31 :     # The SEED Toolkit is free software. You can redistribute
32 :     # it and/or modify it under the terms of the SEED Toolkit
33 :     # Public License.
34 :     #
35 :     # You should have received a copy of the SEED Toolkit Public License
36 :     # along with this program; if not write to the University of Chicago
37 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
38 :     # Genomes at veronika@thefig.info or download a copy from
39 :     # http://www.theseed.org/LICENSE.TXT.
40 :     #
41 :    
42 :    
43 :     use FIG;
44 :     my $fig = new FIG;
45 :    
46 :     use HTML;
47 :     use strict;
48 :    
49 :     use CGI;
50 :     my $cgi = new CGI;
51 :    
52 :     my $user = $cgi->param('user');
53 :     if (0)
54 :     {
55 :     my $VAR1;
56 :     eval(join("",`cat /tmp/tmp.bad`));
57 :     $cgi = $VAR1;
58 :     # print STDERR &Dumper($cgi);
59 :     }
60 :    
61 :     if (0)
62 :     {
63 :     print $cgi->header;
64 :     my @params = $cgi->param;
65 :     print "<pre>\n";
66 :     foreach $_ (@params)
67 :     {
68 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
69 :     }
70 :    
71 :     if (0)
72 :     {
73 :     if (open(TMP,">/tmp/tmp.bad"))
74 :     {
75 :     print TMP &Dumper($cgi);
76 :     close(TMP);
77 :     }
78 :     }
79 :     exit;
80 :     }
81 :    
82 :     my $html = [];
83 :    
84 :     my $file = "$FIG_Config::temp/to.check";
85 :     if (! -s $file)
86 :     {
87 :     push(@$html,$cgi->h1("tell Ross that the to.check file needs to be updated"));
88 :     &HTML::show_page($cgi,$html);
89 :     exit;
90 :     }
91 :    
92 :     my $user = $cgi->param('user');
93 :     if (! $user)
94 :     {
95 :     my @curators = map { $_ =~ /^(\S+)/; $1 } `grep "^[a-zA-Z]" $file | grep -v fig | cut -f1 | sort -u`;
96 :    
97 :     push(@$html,
98 :     $cgi->start_form(-action => "bad_roles.cgi", -method => 'post'),
99 :     $cgi->h1("pick curator"),
100 :     $cgi->scrolling_list(-name => 'user', -values => [@curators], -size => 30, -multiple => 0),
101 :     $cgi->hr,
102 :     $cgi->submit('show problems'),
103 :     $cgi->end_form
104 :     );
105 :     }
106 :     else
107 :     {
108 :     $/ = "\n//\n";
109 :     open(IN,"<$file") || die "could not open $file";
110 :     while (defined($_ = <IN>))
111 :     {
112 :     chomp;
113 :     if ($_ =~ /^$user\t(\S[^\t]+\S)\t(\S[^\n]+\S)\n(.*)/s)
114 :     {
115 :     my($sub,$role,$sets) = ($1,$2,$3);
116 :     my @sets = map { $_ =~ s/^\|/fig\|/; $_ } split(/\nfig/,$sets);
117 :     if (@sets < 2) { die "BAD SETS: $sets"; }
118 :     my @sets1 = ();
119 :     foreach my $set (@sets)
120 :     {
121 :     my @pegs = grep { my $peg = $_;
122 :     my $func = $fig->function_of($peg);
123 :     (index($func,$role) >= 0) ? $peg : () }
124 :     ($set =~ /fig\|\d+\.\d+\.peg\.\d+/g);
125 :     if (@pegs > 0)
126 :     {
127 :     push(@sets1,[@pegs]);
128 :     }
129 :     }
130 :    
131 :     @sets = sort { @$b <=> @$a } @sets1;
132 :    
133 :     if (@sets > 1)
134 :     {
135 :     my $tab = [];
136 :     my $col_hdrs = ['Subsystem','Role','Set'];
137 :     my $first = shift @sets;
138 :     push(@$tab,[$sub,$role,&format_set($first,$cgi)]);
139 :     foreach my $set (@sets)
140 :     {
141 :     push(@$tab,['&nbsp','&nbsp',&format_set($set,$cgi)]);
142 :     }
143 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Possible Problems"),$cgi->hr);
144 :     }
145 :     }
146 :     }
147 :     }
148 :     &HTML::show_page($cgi,$html);
149 :     exit;
150 :    
151 :     sub format_set {
152 :     my($set,$cgi) = @_;
153 :     my $ln = @$set;
154 :     my @show = @$set;
155 :     if ($ln > 5) { $#show = 4; }
156 :     @show = map { &HTML::fid_link($cgi,$_) } @show;
157 :     return "[$ln]&nbsp;&nbsp;" . join(",",@show);
158 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3