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

Annotation of /FigWebServices/figfam_proto.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download)

1 : mkubal 1.1 # -*- perl -*-
2 :    
3 :     use FIG;
4 : mkubal 1.2 use FigFam;
5 : mkubal 1.1 use FIG_Config;
6 :     use HTML;
7 :     use CGI;
8 :     my $cgi=new CGI;
9 :     use LWP::Simple qw(!head); # see the caveat in perldoc LWP about importing two head methods.
10 :    
11 :     $fig = new FIG;
12 :     my $html = [];
13 :    
14 :     unshift(@$html, "<TITLE>Domain Analysis of Protein Sets</TITLE>\n");
15 :    
16 :     my $inputs;
17 :     if ($cgi->param('request') )
18 :     {
19 :     my $input =$cgi->param('proteins');
20 :     my @inputs = split("\n",$input);
21 :    
22 :     if ($cgi->upload('fileupload'))
23 :     {
24 :     my $fh=$cgi->upload('fileupload');
25 :     @inputs = <$fh> ;
26 :     }
27 :    
28 :     $given = [@inputs];
29 :     &analyze_domains($cgi,$fig,$given);
30 :    
31 :     }
32 :     else
33 :     {
34 :     &show_initial($fig,$cgi,$html);
35 :     &HTML::show_page($cgi,$html,1);
36 :     exit;
37 :     }
38 :    
39 :     sub show_initial {
40 :     my ($fig,$cgi,$html)=@_;
41 :     push @$html,
42 :     $cgi->start_multipart_form(),
43 :     "<h3>Enter FigFam ID</h3>",
44 :     $cgi->textarea(-name=>"figfam_id", -rows=>1, -columns=>20),
45 :     $cgi->br,
46 :     "<h3>Enter set of pegs</h3>\n",
47 :     $cgi->textarea(-name=>"set_of_pegs", -rows=>10, -columns=>40),
48 :     $cgi->br,
49 :     "<h3>Upload File</h3>",
50 :     $cgi->filefield(-name=>"fileupload", -size=>50),
51 :     $cgi->br,
52 :     $cgi->hr,
53 :     $cgi->submit(-name=>'request', -value=>'Submit for Domain Analysis'),
54 :     $cgi->reset, $cgi->end_form;
55 :     return $html;
56 :     }
57 :    
58 :     sub analyze_domains
59 :     {
60 :     my ($cgi,$fig,$given) =@_;
61 :    
62 :     my $sops = $cgi->param('set_of_pegs');
63 :     my $figfam_id = $cgi->param('figfam_id');
64 : mkubal 1.2 my $figfam = FigFam->new($fig,$figfam_id);
65 : mkubal 1.3 my $function = $figfam->family_function();
66 :     my %peg_to_domain;
67 :     my %peg_to_score;
68 : mkubal 1.2 my %domain;
69 : mkubal 1.3 my %domain_location;
70 :     my %domain_length;
71 :    
72 :     my $set = $figfam->pegs_of();
73 :     my $count = scalar(@$set);
74 :    
75 : mkubal 1.1 if($figfam_id){
76 : mkubal 1.3 my @returns = $fig->get_attributes($set,'CDD');
77 :     foreach $return (@returns){
78 :     my $peg = @$return[0];
79 :     my $seq = $fig->get_translation($peg);
80 :     my $length = length($seq);
81 :    
82 :     if(@$return[2] =~/^(\d+\.\d+);(\d+)-(\d+)/){
83 :     my $score = $1;
84 :     my $begin = $2;
85 :     my $end = $3;
86 :     my $begin_percent = $begin/$length;
87 :     my $end_percent = $end/$length;
88 :    
89 :     if($peg_to_score{$peg}){
90 :     if($peg_to_score{$peg} > $score){
91 :     $peg_to_score{$peg} = $score;
92 :     if(@$return[1] =~/(\d+)/){
93 :     my $id = $1;
94 :     $peg_to_domain{$peg} = "$id\t$begin_percent\t$end_percent\t$length";
95 :     }
96 :     }
97 :     }
98 :     else{
99 :     $peg_to_score{$peg} = $score;
100 : mkubal 1.2 if(@$return[1] =~/(\d+)/){
101 :     my $id = $1;
102 : mkubal 1.3 $peg_to_domain{$peg} = "$id\t$begin_percent\t$end_percent\t$length";
103 : mkubal 1.2 }
104 : mkubal 1.1 }
105 :     }
106 : mkubal 1.3
107 : mkubal 1.2 }
108 : mkubal 1.3
109 :     foreach $peg (keys(%peg_to_domain)){
110 :     my($id,$begin,$end,$length) = split("\t",$peg_to_domain{$peg});
111 :     my $number;
112 :     if($domain{$id}){
113 :     $number = $domain{$id};
114 :     $domain_begin{$id} = (($domain_begin{$id} * $number) + $begin)/($number + 1);
115 :     $domain_end{$id} = (($domain_end{$id} * $number) + $end)/($number + 1);
116 :     $domain_length{$id} = (($domain_length{$id} * $number) + $length)/($number + 1);
117 :     $domain{$id} = $number + 1;
118 :     }
119 :     else{
120 :     $domain{$id} = 1;
121 :     $domain_begin{$id} = $begin;
122 :     $domain_end{$id} = $end;
123 :     $domain_length{$id} = $length;
124 :     }
125 :     }
126 : mkubal 1.1
127 :     push @$html,
128 : mkubal 1.3 "<h3>Domain Analysis Results for $count pegs in $figfam_id</h3>",
129 :     "<h3>Family Function: $function</h3>",
130 : mkubal 1.1 "<br>",
131 : mkubal 1.3 "<table border>";
132 :     push @$html,"<tr><td>CDD Domain</td><td>Occurences</td><td>AVG Protein Length</td><td>AVG Begin</td><td>AVG End</td></tr>";
133 :    
134 : mkubal 1.1 foreach $dom (keys(%domain)){
135 : mkubal 1.3 my ($length,$begin,$end);
136 :     my $instances = $domain{$dom};
137 :     if($domain_length{$dom} =~/^(\d+)/){$length = $1};
138 :     $begin = $domain_begin{$dom};
139 :     $end = $domain_end{$dom};
140 :    
141 :     push @$html,"<tr><td>$dom</td><td>$instances</td><td>$length</td><td>$begin</td><td>$end</td></tr>";
142 : mkubal 1.1 }
143 : mkubal 1.2 push @$html,"</table>";
144 : mkubal 1.1
145 :     &HTML::show_page($cgi,$html,1);
146 :     exit;
147 : mkubal 1.3 }
148 :    
149 : mkubal 1.1 else{
150 :     push @$html,
151 :     "<h3>Must enter either FigFam ID or set of pegs</h3>";
152 :     &HTML::show_page($cgi,$html,1);
153 :     exit;
154 :     }
155 : mkubal 1.3
156 : mkubal 1.1 }
157 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3