[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.6 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3