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

Annotation of /FigWebServices/fusions.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : efrank 1.1 use FIG;
2 :     my $fig = new FIG;
3 :    
4 :     use HTML;
5 :     use CGI;
6 :     my $cgi = new CGI;
7 :     use GenoGraphics;
8 :    
9 :    
10 :     if (0)
11 :     {
12 :     print $cgi->header;
13 :     my @params = $cgi->param;
14 :     print "<pre>\n";
15 :     foreach $_ (@params)
16 :     {
17 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
18 :     }
19 :     exit;
20 :     }
21 :    
22 :     my $html = [];
23 :     my $peg = $cgi->param('peg');
24 :     if (! $peg)
25 :     {
26 :     push(@$html,$cgi->h1("Sorry, but you need to specify a PEG"));
27 :     &HTML::show_page($cgi,$html);
28 :     exit;
29 :     }
30 :    
31 :     my @fusions = `$FIG_Config::bin/compute_potential_fusions \'$peg\'`;
32 :     if (@fusions < 1)
33 :     {
34 :     push(@$html,$cgi->h1("Sorry, no fusions detected"));
35 :     &HTML::show_page($cgi,$html);
36 :     exit;
37 :     }
38 :    
39 :     my(@contains,@contained_in);
40 :     my($x,$genes,$b,$e,$peg1,$gg);
41 :     foreach $_ (@fusions)
42 :     {
43 :     chop;
44 :     my($contains,$ln,@parts) = split(/\t/,$_);
45 :     if ($contains eq $peg)
46 :     {
47 :     push(@contains,[@parts]);
48 :     $peg_ln = $ln;
49 :     }
50 :     else
51 :     {
52 :     $key = join(",",map { @f = split(/,/,$_); $f[2] } @parts);
53 :     push(@{$contained_in{$key}}, [$contains,$ln,@parts]);
54 :     }
55 :     }
56 :    
57 :     #print &Dumper(["contains",\@contains]);
58 :     if (@contains > 0)
59 :     {
60 :     push(@$html,$cgi->h1("Given PEG is the Potential Fusion (RED)"));
61 :     if (@contains > 10)
62 :     {
63 :     $_ = @contains;
64 :     push(@$html,$cgi->h1("Truncating from $_ to 10 Cases"));
65 :     $#contains = 9;
66 :     }
67 :    
68 :     $gg = [[&FIG::abbrev($fig->org_of($peg)),1,$peg_ln,[[1,$peg_ln,"rightArrow","red",$peg,&HTML::fid_link($cgi,$peg,0,1)]]]];
69 :    
70 :     ($x,$genes,$b,$e,$peg1);
71 :     foreach $x (@contains)
72 :     {
73 :     $genes = [];
74 :     foreach $y (@$x)
75 :     {
76 :     ($b,$e,$peg1) = split(/,/,$y);
77 :     push(@$genes,[$b,$e,"rightArrow","blue",$peg1,&HTML::fid_link($cgi,$peg1,0,1)]);
78 :     }
79 :     push(@$gg,[&FIG::abbrev($fig->org_of($peg1)),1,$peg_ln,$genes]);
80 :     }
81 :     # print &Dumper(["contains-gg",$gg]);
82 :     push(@$html,@{ &GenoGraphics::render($gg,700,4,0,1) });
83 :     push(@$html,$cgi->hr);
84 :     }
85 :    
86 :     #print &Dumper(["contained-in",\%contained_in]);
87 :     my(@keys,$key,$contains,@parts);
88 :     @keys = keys(%contained_in);
89 :     if (@keys > 0)
90 :     {
91 :     push(@$html,$cgi->h1("Given PEG (RED) is Potentially Part of a Fusion in Another Genome"));
92 :     foreach $key (@keys)
93 :     {
94 :     $x = $contained_in{$key};
95 :     if (@$x > 10) { $#{$x} = 9 }
96 :     $gg = [];
97 :     foreach $y (@$x)
98 :     {
99 :     ($contains,$ln,@parts) = @$y;
100 :     push(@$gg,[&FIG::abbrev($fig->org_of($contains)),1,$ln,[[1,$ln,"rightArrow","blue",$contains,&HTML::fid_link($cgi,$contains,0,1)]]]);
101 :     }
102 :     $genes = [];
103 :     my @just_first = @{$x->[0]};
104 :     splice(@just_first,0,2);
105 :     foreach $part (@just_first)
106 :     {
107 :     ($b,$e,$peg1) = split(/,/,$part);
108 :     $color = ($peg1 eq $peg) ? "red" : "green";
109 :     push(@$genes,[$b,$e,"rightArrow",$color,$peg1,&HTML::fid_link($cgi,$peg1,0,1)]);
110 :     }
111 :     push(@$gg,[&FIG::abbrev($fig->org_of($peg)),1,$x->[0]->[1],$genes]);
112 :     # print STDERR &Dumper($gg);
113 :     push(@$html,@{ &GenoGraphics::render($gg,700,4,0,2) });
114 :     push(@$html,$cgi->hr);
115 :     }
116 :     }
117 :    
118 :     &HTML::show_page($cgi,$html);

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3