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

Annotation of /FigWebServices/check_fc.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 :     #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 :    
20 :     use FIG;
21 :     my $fig = new FIG;
22 :    
23 :     use Subsystem;
24 :    
25 :     use HTML;
26 :     use strict;
27 :    
28 :     use CGI;
29 :     my $cgi = new CGI;
30 :    
31 :     my $user = $cgi->param('user');
32 :    
33 :     $fig->set_user($user);
34 :    
35 :     if (0)
36 :     {
37 :     my $VAR1;
38 :     eval(join("",`cat /tmp/check_fc_parms`));
39 :     $cgi = $VAR1;
40 :     # print STDERR &Dumper($cgi);
41 :     }
42 :    
43 :     if (0)
44 :     {
45 :     print $cgi->header;
46 :     my @params = $cgi->param;
47 :     print "<pre>\n";
48 :     foreach $_ (@params)
49 :     {
50 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
51 :     }
52 :    
53 :     if (0)
54 :     {
55 :     if (open(TMP,">/tmp/check_fc_parms"))
56 :     {
57 :     print TMP &Dumper($cgi);
58 :     close(TMP);
59 :     }
60 :     }
61 :     exit;
62 :     }
63 :    
64 :     my $html = [];
65 :     unshift @$html, "<TITLE>Check FC</TITLE>\n";
66 :    
67 :     my($peg);
68 :    
69 :     if ($peg = $cgi->param('prot'))
70 :     {
71 :     my $genome1 = &FIG::genome_of($peg);
72 :     my ($contig,$beg,$end) = $fig->boundaries_of($fig->feature_location($peg));
73 :     my $beg1 = &FIG::max(1,int(($beg+$end)/2) - 5000);
74 :     my $end1 = &FIG::min(int(($beg+$end)/2) + 5000,$fig->contig_ln(&FIG::genome_of($peg),$contig));
75 :     my($features,$beg2,$end2) = $fig->genes_in_region($genome1,$contig,$beg1,$end1);
76 :     my @pegs = grep { ($_ =~ /^fig\|\d+\.\d+\.peg\./) } @$features;
77 :    
78 :     my(%loc,%similarities);
79 :     foreach my $peg1 (@pegs)
80 :     {
81 :     my($contig1,$b1,$e1) = $fig->boundaries_of($fig->feature_location($peg1));
82 :     $loc{$peg1} = [$contig1,int(($b1+$e1)/2)];
83 :     }
84 :    
85 :     foreach my $sim ($fig->sims(\@pegs,50000,1.0e-5,"fig"))
86 :     {
87 :     my $id2 = $sim->id2;
88 :     push(@{$similarities{$sim->id1}->{&FIG::genome_of($id2)}},$id2);
89 :     my($contig2,$b2,$e2) = $fig->boundaries_of($fig->feature_location($id2));
90 :     $loc{$id2} = [$contig2,int(($b2+$e2)/2)];
91 :     }
92 :     my %pinned_to;
93 :     #
94 :     # http://anno-3.nmpdr.org/anno/FIG/chromosomal_clusters.cgi?sim_cutoff=1.0e-5&prot=fig|243274.1.peg.1892&pinned_to=fig|489351.1.peg.3213,fig|266117.1.peg.1288
95 :     #
96 :     foreach my $genome (keys(%{$similarities{$peg}}))
97 :     {
98 :     my @pegs1 = @{$similarities{$peg}->{$genome}};
99 :     foreach my $peg2 (grep { $_ ne $peg} @pegs)
100 :     {
101 :     my $x = $similarities{$peg2}->{$genome};
102 :     if ($x)
103 :     {
104 :     my @pegs2 = @$x;
105 :     foreach my $peg1 (@pegs1)
106 :     {
107 :     my $loc1 = $loc{$peg1};
108 :     foreach my $peg2 (@pegs2)
109 :     {
110 :     my $loc2 = $loc{$peg2};
111 :     if (($loc1->[0] eq $loc2->[0]) && (abs($loc1->[1] - $loc2->[1]) < 5000))
112 :     {
113 :     $pinned_to{$peg1} = 1;
114 :     }
115 :     }
116 :     }
117 :     }
118 :     }
119 :     }
120 :     my @pinned_to = keys(%pinned_to);
121 :     my $parm = join(",",@pinned_to);
122 :     $ENV{REQUEST_METHOD} = 'GET';
123 :     $ENV{QUERY_STRING} = "prot=$peg&pinned_to=$parm&sim_cutoff=1.0e-3";
124 :     my $out = join("",`./chromosomal_clusters.cgi`);
125 :     $out =~ s/^.*?(\n<script language)/$1/s;
126 :     $out =~ s/^(.*)\n<hr>.*/$1/s;
127 :     push(@$html,$out);
128 :     }
129 :     else
130 :     {
131 :     push(@$html,$cgi->h1('invalid parameters'));
132 :     }
133 :    
134 :     &HTML::show_page($cgi,$html);
135 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3