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

Annotation of /FigWebServices/co_occurs_server.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (view) (download)

1 : overbeek 1.1 use strict;
2 :     use Data::Dumper;
3 : olson 1.4 use CGI::Fast;
4 :     use CGI;
5 :     use ERDB;
6 :     use FC;
7 :    
8 : overbeek 1.1
9 :     use YAML;
10 :    
11 : olson 1.4 use FIG;
12 : overbeek 1.1
13 :     my $fig = new FIG;
14 :    
15 : olson 1.4 my $db = ERDB::GetDatabase('Sapling');
16 : overbeek 1.1
17 : olson 1.4 #
18 :     # If no CGI vars, assume we are invoked as a fastcgi service.
19 :     #
20 :     if ($ENV{REQUEST_METHOD} eq '')
21 :     {
22 :     while (my $cgi = new CGI::Fast())
23 :     {
24 :     eval {
25 :     &process($cgi);
26 :     };
27 :     if ($@)
28 :     {
29 :     if (ref($@) ne 'ARRAY')
30 :     {
31 :     warn "code died, returning error\n";
32 :     print $cgi->header(-status => '500 error in body of cgi processing');
33 :     print $@;
34 :     }
35 :     }
36 :     }
37 :     }
38 :     else
39 :     {
40 :     my $cgi = new CGI();
41 :     print $cgi->header();
42 :     &process($cgi);
43 :     }
44 : overbeek 1.1
45 : olson 1.4 exit;
46 : overbeek 1.1
47 : olson 1.4 sub myerror
48 :     {
49 :     my($cgi, $stat, $msg) = @_;
50 :     print $cgi->header(-status => $stat);
51 :     print "$msg\n";
52 :     die ['cgi error returned'];
53 :     }
54 :    
55 :     sub process
56 : overbeek 1.1 {
57 : olson 1.4 my($cgi) = @_;
58 :    
59 :     my $function = $cgi->param('function');
60 :     $function || myerror($cgi, "500 missing function", "Missing a function in call to co_occurs_server.cgi");
61 :    
62 :     if ($function eq "conserved_in_neighborhood")
63 : overbeek 1.1 {
64 : olson 1.4 my $pegs = &YAML::Load($cgi->param('args'));
65 :     my $tuples = [];
66 :     foreach my $peg (@$pegs)
67 : overbeek 1.1 {
68 : olson 1.4 my $group = [];
69 :     my @co_occurs = &FC::co_occurs($db,$peg);
70 :     foreach my $tuple (@co_occurs)
71 :     {
72 :     my($sc,$fid,$pairset) = @$tuple;
73 :     push(@$group,[$sc,$fid,scalar $fig->function_of($fid),$pairset]);
74 :     }
75 :     push(@$tuples,$group);
76 : overbeek 1.1 }
77 : disz 1.3
78 : olson 1.4 print $cgi->header();
79 :     my $str = &YAML::Dump($tuples);
80 :     print $str;
81 : overbeek 1.1 }
82 : olson 1.4 elsif ($function eq "pairsets")
83 : overbeek 1.2 {
84 : olson 1.4 my $pairsets = &YAML::Load($cgi->param('args'));
85 :     my $ans = [];
86 :     foreach my $pairset (@$pairsets)
87 :     {
88 :     push(@$ans,[$pairset,[&FC::co_occurrence_set($db,$pairset)]]);
89 :     }
90 :     print $cgi->header();
91 :     print &YAML::Dump($ans);
92 : overbeek 1.2 }
93 : olson 1.4 elsif ($function eq "clusters_containing")
94 : overbeek 1.2 {
95 : olson 1.4 my $pegs = &YAML::Load($cgi->param('args'));
96 :     my $ans = [];
97 :     foreach my $peg (@$pegs)
98 : overbeek 1.2 {
99 : olson 1.4 my $cluster = &FC::in_co_occurrence_cluster($db,$peg);
100 :     if ($cluster)
101 :     {
102 :     my $func = scalar $fig->function_of($peg);
103 :     push(@$ans,[$peg,$func,[map { [$_,scalar $fig->function_of($_)] } @$cluster]]);
104 :     }
105 : overbeek 1.2 }
106 : olson 1.4 print $cgi->header();
107 :     print &YAML::Dump($ans);
108 : overbeek 1.2 }
109 : olson 1.4 elsif ($function eq "related_clusters")
110 :     {
111 :     my $pegs = &YAML::Load($cgi->param('args'));
112 :     my $ans = [];
113 :     foreach my $peg (@$pegs)
114 :     {
115 :     my $one_set = [];
116 :     my @clusters = &FC::largest_co_occurrence_clusters($db,$peg);
117 :     foreach my $cluster (@clusters)
118 :     {
119 :     my($peg1,$sc,$other_pegs) = @$cluster;
120 :     my $func1 = $fig->function_of($peg1);
121 :     my $others = [ map { [$_,scalar $fig->function_of($_)] } @$other_pegs];
122 :     push(@$one_set,[$peg1,$sc,$others]);
123 :     }
124 :     push(@$ans,$one_set);
125 : overbeek 1.2 }
126 : olson 1.4 print $cgi->header();
127 :     print &YAML::Dump($ans);
128 : overbeek 1.2 }
129 : olson 1.4 elsif ($function eq "related_figfams")
130 : overbeek 1.2 {
131 : olson 1.4 my $ffs = &YAML::Load($cgi->param('args'));
132 :     my $ans = [];
133 :     foreach my $ff (@$ffs)
134 :     {
135 :     push(@$ans,[$ff,[&FC::co_occurring_FIGfams($db,$ff)]]);
136 :     }
137 :     print $cgi->header();
138 :     print &YAML::Dump($ans);
139 : overbeek 1.2 }
140 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3