[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.5 - (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.4 while (my $cgi = new CGI::Fast())
35 :     {
36 :     eval {
37 :     &process($cgi);
38 :     };
39 :     if ($@)
40 :     {
41 :     if (ref($@) ne 'ARRAY')
42 :     {
43 :     warn "code died, returning error\n";
44 :     print $cgi->header(-status => '500 error in body of cgi processing');
45 :     print $@;
46 :     }
47 :     }
48 :     }
49 :     }
50 :     else
51 :     {
52 :     my $cgi = new CGI();
53 :     print $cgi->header();
54 :     &process($cgi);
55 :     }
56 : overbeek 1.1
57 : olson 1.4 exit;
58 : overbeek 1.1
59 : olson 1.4 sub myerror
60 :     {
61 :     my($cgi, $stat, $msg) = @_;
62 :     print $cgi->header(-status => $stat);
63 :     print "$msg\n";
64 :     die ['cgi error returned'];
65 :     }
66 :    
67 :     sub process
68 : overbeek 1.1 {
69 : olson 1.4 my($cgi) = @_;
70 :    
71 :     my $function = $cgi->param('function');
72 :     $function || myerror($cgi, "500 missing function", "Missing a function in call to co_occurs_server.cgi");
73 :    
74 :     if ($function eq "conserved_in_neighborhood")
75 : overbeek 1.1 {
76 : olson 1.4 my $pegs = &YAML::Load($cgi->param('args'));
77 :     my $tuples = [];
78 :     foreach my $peg (@$pegs)
79 : overbeek 1.1 {
80 : olson 1.4 my $group = [];
81 :     my @co_occurs = &FC::co_occurs($db,$peg);
82 :     foreach my $tuple (@co_occurs)
83 :     {
84 :     my($sc,$fid,$pairset) = @$tuple;
85 :     push(@$group,[$sc,$fid,scalar $fig->function_of($fid),$pairset]);
86 :     }
87 :     push(@$tuples,$group);
88 : overbeek 1.1 }
89 : disz 1.3
90 : olson 1.4 print $cgi->header();
91 :     my $str = &YAML::Dump($tuples);
92 :     print $str;
93 : overbeek 1.1 }
94 : olson 1.4 elsif ($function eq "pairsets")
95 : overbeek 1.2 {
96 : olson 1.4 my $pairsets = &YAML::Load($cgi->param('args'));
97 :     my $ans = [];
98 :     foreach my $pairset (@$pairsets)
99 :     {
100 :     push(@$ans,[$pairset,[&FC::co_occurrence_set($db,$pairset)]]);
101 :     }
102 :     print $cgi->header();
103 :     print &YAML::Dump($ans);
104 : overbeek 1.2 }
105 : olson 1.4 elsif ($function eq "clusters_containing")
106 : overbeek 1.2 {
107 : olson 1.4 my $pegs = &YAML::Load($cgi->param('args'));
108 :     my $ans = [];
109 :     foreach my $peg (@$pegs)
110 : overbeek 1.2 {
111 : olson 1.4 my $cluster = &FC::in_co_occurrence_cluster($db,$peg);
112 :     if ($cluster)
113 :     {
114 :     my $func = scalar $fig->function_of($peg);
115 :     push(@$ans,[$peg,$func,[map { [$_,scalar $fig->function_of($_)] } @$cluster]]);
116 :     }
117 : overbeek 1.2 }
118 : olson 1.4 print $cgi->header();
119 :     print &YAML::Dump($ans);
120 : overbeek 1.2 }
121 : olson 1.4 elsif ($function eq "related_clusters")
122 :     {
123 :     my $pegs = &YAML::Load($cgi->param('args'));
124 :     my $ans = [];
125 :     foreach my $peg (@$pegs)
126 :     {
127 :     my $one_set = [];
128 :     my @clusters = &FC::largest_co_occurrence_clusters($db,$peg);
129 :     foreach my $cluster (@clusters)
130 :     {
131 :     my($peg1,$sc,$other_pegs) = @$cluster;
132 :     my $func1 = $fig->function_of($peg1);
133 :     my $others = [ map { [$_,scalar $fig->function_of($_)] } @$other_pegs];
134 :     push(@$one_set,[$peg1,$sc,$others]);
135 :     }
136 :     push(@$ans,$one_set);
137 : overbeek 1.2 }
138 : olson 1.4 print $cgi->header();
139 :     print &YAML::Dump($ans);
140 : overbeek 1.2 }
141 : olson 1.4 elsif ($function eq "related_figfams")
142 : overbeek 1.2 {
143 : olson 1.4 my $ffs = &YAML::Load($cgi->param('args'));
144 :     my $ans = [];
145 :     foreach my $ff (@$ffs)
146 :     {
147 :     push(@$ans,[$ff,[&FC::co_occurring_FIGfams($db,$ff)]]);
148 :     }
149 :     print $cgi->header();
150 :     print &YAML::Dump($ans);
151 : overbeek 1.2 }
152 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3