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

Annotation of /FigWebServices/subsystem_server_sapling.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (view) (download)

1 : disz 1.1 use strict;
2 :     use Data::Dumper;
3 :     use FIG;
4 :     use CGI::Fast;
5 :     use CGI;
6 :     use Sapling;
7 :     use SaplingSubsys;
8 :     use YAML;
9 :     use ERDB;
10 :    
11 :     my $fig = new FIG;
12 :     my $sapling = ERDB::GetDatabase('Sapling');
13 :    
14 :    
15 :     #
16 :     # If no CGI vars, assume we are invoked as a fastcgi service.
17 :     #
18 :     if ($ENV{REQUEST_METHOD} eq '')
19 :     {
20 :     while (my $cgi = new CGI::Fast())
21 :     {
22 :     eval {
23 :     &process_request($cgi);
24 :     };
25 :     if ($@)
26 :     {
27 :     if (ref($@) ne 'ARRAY')
28 :     {
29 :     warn "code died, returning error\n";
30 :     print $cgi->header(-status => '500 error in body of cgi processing');
31 :     print $@;
32 :     }
33 :     }
34 :     }
35 :     }
36 :     else
37 :     {
38 :     my $cgi = new CGI();
39 :     print $cgi->header();
40 :     &process_request($cgi);
41 :     }
42 :    
43 :     exit;
44 :    
45 :     sub process_request
46 :     {
47 :     my($cgi) = @_;
48 :    
49 :    
50 :     my $i = 0;
51 :     my $result = [];
52 :     my $function = $cgi->param('function');
53 :     $function or myerror($cgi, "500 missing argument", "subsystem server missing function argument");
54 :    
55 :    
56 :     if ($function eq "is_in_subsystem") {
57 :     my $ids = &YAML::Load($cgi->param('args'));
58 :     $ids or myerror($cgi, "500 missing id", "subsystem server missing id argument");
59 :     foreach my $fid (@$ids) {
60 :     my @resultRows = $sapling->GetAll("Subsystem Includes Role IsRoleOf MachineRole Contains Feature",
61 :     'Feature(id) = ?', [$fid],
62 :     [qw(Subsystem(id) Role(id) Feature(id))]);
63 :     push (@$result, \@resultRows);
64 :     }
65 :     print $cgi->header();
66 :     print &YAML::Dump($result);
67 :    
68 :     } elsif ($function eq "is_in_subsystem_with") {
69 :     print $cgi->header();
70 :     my $ids = &YAML::Load($cgi->param('args'));
71 :     $ids or myerror($cgi, "500 missing id", "subsystem server missing id argument");
72 :     my $result = [];
73 :     foreach my $fid (@$ids) {
74 :     # if this is not a fig id, look up the fig id equivalent
75 :     my @resultRows = $sapling->GetAll("Feature IsContainedIn MachineRole IsRoleFor MolecularMachine Implements Variant IsDescribedBy Subsystem AND MolecularMachine IsMachineOf MachineRole2 Contains Feature2 AND MachineRole2 HasRole Role",
76 :     'Feature(id) = ? ',
77 :     [$fid], [qw(Subsystem(id)
78 :     Variant(id) Feature(id) Feature2(id) Feature2(function) Role(id))]);
79 :     push (@$result, \@resultRows);
80 :     }
81 :     print &YAML::Dump($result);
82 :    
83 :     } elsif ($function eq "all_subsystems") {
84 : disz 1.3 #print $cgi->header();
85 : disz 1.1
86 :     my @resultRows = $sapling->GetAll("Subsystem Includes Role",
87 :     'ORDER BY Subsystem(id)', [], [qw(Subsystem(id) Subsystem(curator)
88 :     Role(id))]);
89 :     print &YAML::Dump(\@resultRows);
90 :    
91 :     } elsif ($function eq "subsystem_spreadsheet") {
92 :     print $cgi->header();
93 :     my $names = &YAML::Load($cgi->param('args'));
94 :     $names or myerror($cgi, "500 missing id", "subsystem server missing id argument");
95 :     my $result = [];
96 :     foreach my $subsysName (@$names) {
97 :     my @resultRows = $sapling->GetAll("Subsystem Describes Variant IsImplementedBy MolecularMachine IsMachineOf MachineRole Contains Feature AND MachineRole HasRole Role",
98 :     'Subsystem(id) = ? ORDER BY Feature(id)',
99 :     [$subsysName], [qw(Subsystem(id) Variant(id)
100 :     Feature(id) Feature(function) Role(id))]);
101 :     push (@$result, \@resultRows);
102 :     }
103 :     print &YAML::Dump($result);
104 :    
105 : disz 1.3 } elsif ($function eq "pegs_in_subsystems") {
106 :     my $result = [];
107 :     my (@args) = &YAML::Load($cgi->param('args'));
108 : disz 1.6 my $genomes = $args[0];
109 :     my $subs = $args[1];
110 :     foreach my $sub (@{$subs}) {
111 :     my $ss = SaplingSubsys->new($sub, $sapling);
112 :     foreach my $g (@{$genomes}) {
113 :     my @roles = $ss->get_roles_for_genome($g, 1);
114 : disz 1.3 foreach my $role (@roles) {
115 : disz 1.6 push (@$result, [$sub, $role]);
116 : disz 1.3 }
117 :     }
118 :     }
119 :     print &YAML::Dump($result);
120 :    
121 :     } elsif ($function eq "pegs_implementing_roles") {
122 :     my $result = [];
123 :     my (@args) = &YAML::Load($cgi->param('args'));
124 :     my $subsys = $args[0];
125 : disz 1.4 my @roles = @{$args[1]};
126 : disz 1.3 my $ss = SaplingSubsys->new($subsys, $sapling);
127 :     foreach my $role (@roles) {
128 :     my @pegs = $ss->pegs_for_role($role);
129 :     push (@$result, [$role, \@pegs]);
130 :     }
131 :    
132 :     print &YAML::Dump($result);
133 :    
134 : disz 1.1 } elsif ($function eq "metabolic_reconstruction") {
135 :    
136 :     #print $cgi->header();
137 :     my %big;
138 : disz 1.2 my $id_display = 1;
139 : disz 1.1 my $result = [];
140 :    
141 :     my @id_roles = &YAML::Load($cgi->param('args'));
142 : disz 1.2 #map {push(@{$big{$_}}, 1)} @id_roles;
143 : disz 1.1 #map {push(@{$big{$_->[0]}}, 1)} @id_roles;
144 : disz 1.2 map {push(@{$big{$_->[0]}}, $_->[1])} @id_roles;
145 : disz 1.7 #my @resultRows = $sapling->GetFlat("Subsystem", '', [], 'Subsystem(id)');
146 :    
147 :    
148 :    
149 :    
150 :     my @resultRows = $sapling->GetAll("Subsystem Includes Role",
151 :     'ORDER BY Subsystem(id), Includes(sequence)', [],
152 :     [qw(Subsystem(id) Role(id) Includes(abbreviation))]);
153 :    
154 :     my %ss_roles;
155 :     foreach my $row (@resultRows) {
156 :     my ($sub, $role, $abbr) = @$row;
157 :     $ss_roles{$sub}->{$role} = $abbr;
158 :     }
159 :    
160 :     foreach my $sub (keys %ss_roles) {
161 :     my $roles = $ss_roles{$sub};
162 :    
163 :     my @abbr = map{$roles->{$_}} grep { $big{$_}} keys %$roles;
164 : disz 1.1 my $set = join(" ", @abbr);
165 :     if (@abbr > 0) {
166 :     my ($variant, $size) = get_max_subset($sub, $set);
167 :     if ($variant) {
168 : disz 1.7 foreach my $role (keys %$roles) {
169 : disz 1.1 if ($id_display) {
170 :     foreach my $id (@{$big{$role}}) {
171 : disz 1.2 push (@$result, [$variant, $role, $id]);
172 : disz 1.1 }
173 :     } else {
174 :     push (@$result, [$variant, $role]);
175 :     }
176 :     }
177 :     }
178 :     }
179 :    
180 :     #if ($i++ > 10) {
181 :     #print &YAML::Dump($result);
182 :     #exit;
183 :     #}
184 :    
185 :     }
186 :     print &YAML::Dump($result);
187 :     } else {
188 :     myerror($cgi, "500 bad function argument $function", "usage:subsystem_server function=[is-in-subsystem | is-in-subsystem-with | all-subsystems | subsystem-spreadsheet");
189 :     }
190 :     }
191 :    
192 :    
193 :    
194 :    
195 :    
196 :     sub get_max_subset {
197 :     my ($sub, $setA) = @_;
198 :     my $max_size = 0;
199 :     my $max_set;
200 :     my $max_variant;
201 :     my %set_hash;
202 :     my $qh = $sapling->Get("Subsystem Describes Variant", 'Subsystem(id) = ? AND Variant(type) = ?', [$sub, 'normal']);
203 :     while (my $resultRow = $qh->Fetch()) {
204 :     my @variantRoleRule = $resultRow->Value('Variant(role-rule)');
205 : disz 1.5 my ($variantCode) = $resultRow->Value('Variant(code)');
206 : disz 1.1 my $variantId = $sub.":".$variantCode;
207 :     foreach my $setB (@variantRoleRule) {
208 :     my $size = is_A_a_superset_of_B($setA, $setB);
209 :     if ($size && $size > $max_size) {
210 :     $max_size = $size;
211 :     $max_set = $setB;
212 :     $max_variant = $variantId;
213 :     }
214 :     }
215 :     }
216 :     #if ($max_size) {
217 :     #print STDERR "Success $max_variant, $max_set\n";
218 :     #}
219 :     return($max_variant, $max_size);
220 :     }
221 :    
222 :    
223 :    
224 :     sub is_A_a_superset_of_B {
225 :     my ($a, $b) = @_;
226 :     my @a = split(" ", $a);
227 :     my @b = split(" ", $b);
228 :     if (@b > @a) {
229 :     return(0);
230 :     }
231 :     my %given;
232 :     map { $given{$_} = 1} @a;
233 :     map { if (! $given{$_}) {return 0}} split(" ", $b);
234 :     my $l = scalar(@b);
235 :     return scalar(@b);
236 :     }
237 :    
238 :    
239 :     sub myerror
240 :     {
241 :     my($cgi, $stat, $msg) = @_;
242 :     print $cgi->header(-status => $stat);
243 :    
244 :     print "$msg\n";
245 :     die ['cgi error returned'];
246 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3