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

Annotation of /FigWebServices/check_subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 :    
3 :     use FIG;
4 :     my $fig = new FIG;
5 :    
6 :     use Subsystem;
7 :    
8 :     use HTML;
9 :     use strict;
10 :    
11 :     use CGI;
12 :     my $cgi = new CGI;
13 :    
14 :     if (0)
15 :     {
16 :     my $VAR1;
17 :     eval(join("",`cat /tmp/check_ssa_parms`));
18 :     $cgi = $VAR1;
19 :     # print STDERR &Dumper($cgi);
20 :     }
21 :    
22 :     if (0)
23 :     {
24 :     print $cgi->header;
25 :     my @params = $cgi->param;
26 :     print "<pre>\n";
27 :     foreach $_ (@params)
28 :     {
29 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
30 :     }
31 :    
32 :     if (0)
33 :     {
34 :     if (open(TMP,">/tmp/check_ssa_parms"))
35 :     {
36 :     print TMP &Dumper($cgi);
37 :     close(TMP);
38 :     }
39 :     }
40 :     exit;
41 :     }
42 :     my($genome);
43 :    
44 :     my $html = [];
45 :     my $subsys = $cgi->param('subsystem');
46 :     if (! $subsys)
47 :     {
48 :     my @ssa = &existing_subsystem_annotations;
49 :    
50 :     if (@ssa > 0)
51 :     {
52 :     &format_ssa_table($cgi,$html,\@ssa);
53 :     }
54 :     else
55 :     {
56 :     push(@$html,$cgi->h1('Sorry, no subsystems defined'));
57 :     }
58 :     }
59 :     elsif ($subsys && ($cgi->param('request') eq "check_ssa"))
60 :     {
61 :     &check_subsystem($cgi,$fig,$html,$subsys);
62 :     }
63 :     &HTML::show_page($cgi,$html);
64 :    
65 :     sub format_ssa_table {
66 :     my($cgi,$html,$ssaP) = @_;
67 :    
68 : overbeek 1.2 my $user = $cgi->param('user');
69 :     $user = $user ? $user : "";
70 : overbeek 1.1 push(@$html, $cgi->start_form(-action => "check_subsys.cgi",
71 :     -method => 'post'),
72 :     $cgi->hidden(-name => 'request', -value => 'check_ssa', -override => 1),
73 : overbeek 1.2 $cgi->hidden(-name => 'user', -value => "$user", -override => 1),
74 : overbeek 1.1 $cgi->scrolling_list( -name => 'subsystem',
75 :     -values => [ map { $_->[0] } @$ssaP ],
76 :     -size => 10
77 :     ),
78 :     $cgi->br,
79 :     $cgi->submit( 'Pick One' ),
80 :     $cgi->end_form
81 :     );
82 :     }
83 :    
84 :     sub existing_subsystem_annotations {
85 :     my($ssa,$name);
86 :     my @ssa = ();
87 :     if (opendir(SSA,"$FIG_Config::data/Subsystems"))
88 :     {
89 :     @ssa = map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,&curator($ssa)] } grep { $_ !~ /^\./ } readdir(SSA);
90 :     closedir(SSA);
91 :     }
92 :     return sort { $a->[0] cmp $b->[0] } @ssa;
93 :     }
94 :    
95 :     sub curator {
96 :     my($ssa) = @_;
97 :     my($who) = "";
98 :    
99 :     if (open(DATA,"<$FIG_Config::data/Subsystems/$ssa/curation.log"))
100 :     {
101 :     $_ = <DATA>;
102 :     if ($_ =~ /^\d+\t(\S+)\s+started/)
103 :     {
104 :     $who = $1;
105 :     }
106 :     close(DATA);
107 :     }
108 :     return $who;
109 :     }
110 :    
111 :     sub check_subsystem {
112 :     my($cgi,$fig,$html,$subsys) = @_;
113 : redwards 1.4 my($col_hdrs1,$col_hdrs2,$tab1,$tab2,$x);
114 : overbeek 1.1
115 : redwards 1.4 my $user=$cgi->param('user');
116 : overbeek 1.1 my @checked = map { chop; [split(/\t/,$_)] } `$FIG_Config::bin/check_subsystems $subsys`;
117 : redwards 1.4 # RAE: it only makes sense to have Assign Role in column 1, so I duplicate this instead of leaving the column empty. Blah.
118 : redwards 1.6 $col_hdrs1 = ["PEG","Function","Role","Assign Role","Other Subsystems","Genome"];
119 : redwards 1.4 $col_hdrs2 = ["PEG","Function","Role","Other Subsystems","Genome"];
120 : overbeek 1.1 $tab1 = [];
121 :     $tab2 = [];
122 :    
123 :     foreach $x (@checked)
124 :     {
125 :     my($code,$peg,$func,$role,$gs) = @$x;
126 : redwards 1.3 #RAE added the other subsystems column to the table
127 :     my $othersubsys='';
128 :     if (my @otherss = $fig->subsystems_for_peg($peg))
129 :     {
130 :     foreach my $ssr (@otherss)
131 :     {
132 :     next if ($$ssr[0] eq $subsys);
133 : redwards 1.4 $othersubsys .= $cgi->a({href => "subsys.cgi?user=$user&ssa_name=" . $$ssr[0] . "&request=show_ssa"}, $$ssr[0]) . "<br\n";
134 : redwards 1.3 }
135 :     }
136 : overbeek 1.1 my $link = &HTML::fid_link($cgi,$peg);
137 : redwards 1.4 my $checkbox=$cgi->checkbox(-name=>"checked", -label=>'', -value=>"to=$peg,from=$role");
138 : overbeek 1.1 if ($code eq "mismatch")
139 :     {
140 : redwards 1.6 push(@$tab1,[$link,$func,$role,$checkbox,$othersubsys,$gs]);
141 : overbeek 1.1 }
142 :     else
143 :     {
144 : redwards 1.3 push(@$tab2,[$link,$func,$role,$othersubsys,$gs]);
145 : overbeek 1.1 }
146 :     }
147 : redwards 1.4
148 :     # RAE addd the form controls
149 :     push(@$html, $cgi->start_form( -method => 'post', -action => 'fid_checked.cgi', -name => 'fid_checked'), $cgi->hidden(-name => 'user', -value => $user));
150 :     push(@$html,&HTML::make_table($col_hdrs1,$tab1,"PEGs IN Subsystem with MISMATCHING Functions"));
151 : redwards 1.5
152 : redwards 1.6 push(@$html, $cgi->br, &HTML::java_buttons("fid_checked", "checked"), $cgi->br);
153 : redwards 1.7 push(@$html, $cgi->submit(-name=>'batch_assign', -label=>"Assign Roles to Selected PEGs"));
154 : overbeek 1.2 push(@$html,$cgi->hr,$cgi->br,$cgi->br);
155 :    
156 : redwards 1.4 push(@$html,&HTML::make_table($col_hdrs2,$tab2,"PEGs NOT in Subsystem with MATCHING Functions"));
157 : overbeek 1.8 push(@$html,$cgi->end_form);
158 : overbeek 1.1 }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3