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

Annotation of /FigWebServices/pir.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download)

1 : redwards 1.1 # -*- perl -*-
2 :    
3 :     =pod
4 :    
5 :     =head1
6 :    
7 :     Compare some data between SEED and PIR. We probably need to add things like p2p or automatic ftp gets or something like that
8 :    
9 :     =cut
10 :    
11 :     use strict;
12 :     use FIG;
13 :     use HTML;
14 :     use raelib;
15 :     use CGI;
16 :     my $cgi=new CGI;
17 :    
18 :    
19 :     my $fig;
20 :     eval {
21 :     $fig = new FIG;
22 :     };
23 :    
24 :     if ($@ ne "")
25 :     {
26 :     my $err = $@;
27 :    
28 :     my(@html);
29 :    
30 :     push(@html, $cgi->p("Error connecting to SEED database."));
31 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
32 :     {
33 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
34 :     }
35 :     else
36 :     {
37 :     push(@html, $cgi->pre($err));
38 :     }
39 :     &HTML::show_page($cgi, \@html, 1);
40 :     exit;
41 :     }
42 :    
43 :    
44 :    
45 :     $ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};
46 :    
47 :     my $html = [];
48 :     my $user = $cgi->param('user');
49 :    
50 :     # make sure that we read the file at the beginning
51 : redwards 1.2 my ($pegbypir, $pirid) =&read_pir_file();
52 : redwards 1.1
53 :    
54 :    
55 :    
56 :    
57 :    
58 :     if ($cgi->param('pirsf')) {
59 :     # we want to display one of the correspondances
60 : redwards 1.2 my $col_hdrs = ["PIR Superfamily<br><small>Link goes to PIR<small>", "Genome", "PEG", "FIG Function", "FIG Spreadsheet"];
61 : redwards 1.1 my $tab = [];
62 : redwards 1.2 foreach my $peg (@{$pegbypir->{$cgi->param('pirsf')}}) {
63 : redwards 1.1 my @sslinks;
64 :     foreach my $subsys ($fig->subsystems_for_peg($peg)) {
65 :     push @sslinks, $cgi->a({href => "subsys.cgi?&user=$user&ssa_name=" . $$subsys[0] . "&request=show_ssa"}, $$subsys[0]);
66 :     }
67 :    
68 :     my $pirlink=$cgi->param('pirsf');
69 : redwards 1.2 $pirlink =~ /^PIR(SF\d+)/;
70 :     $pirlink="<a href='http://pir.georgetown.edu/sfcs-cgi/new/pirclassif.pl?id=$1'>PIR$1</a>" . $pirid->{$cgi->param('pirsf')};
71 :     push (@$tab, [$pirlink, $fig->genus_species($fig->genome_of($peg)), &HTML::fid_link($cgi, $peg, 1), (scalar $fig->function_of($peg)), (join ", ", @sslinks)]);
72 : redwards 1.1 }
73 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Correspondance between SEED and PIR"));
74 :     }
75 :    
76 :     else {
77 :     unshift @$html, "<TITLE>The SEED - PIR comparison page</TITLE>\n";
78 :     &show_initial($fig,$cgi,$html);
79 :     }
80 :    
81 :     &HTML::show_page($cgi,$html,1);
82 :     exit;
83 :    
84 :    
85 :    
86 :    
87 :    
88 :     sub show_initial {
89 :     my ($fig,$cgi,$html)=@_;
90 :     # generate a blank page
91 :     # we want a list of all functions that have >= 1 peg unless we want all
92 :     my $min=10;
93 :     if ($cgi->param("min")) {$min=$cgi->param("min")}
94 :     if ($cgi->param("showall")) {$min=0}
95 :     my $full=1;
96 :     if ($cgi->param("preliminary")) {$full=0}
97 :     # count different subsystems per sf
98 :     my $ss; my @pirsf;
99 : redwards 1.2 foreach my $sf (keys %$pegbypir) {
100 :     print STDERR "Checking $sf\n";
101 :     next unless ($pegbypir->{$sf});
102 :     next unless (scalar @{$pegbypir->{$sf}} >= $min);
103 :     next if ($full && $pirid->{$sf} =~ /\(preliminary\)/i);
104 :     next if (!$full && $pirid->{$sf} =~ /\(full/i);
105 : redwards 1.1 push @pirsf, $sf;
106 :     if ($cgi->param('showsubsys')) {
107 : redwards 1.2 foreach my $peg (@{$pegbypir->{$sf}}) {
108 : redwards 1.1 foreach my $subsys ($fig->subsystems_for_peg($peg)) {
109 :     $ss->{$sf}->{$$subsys[0]}++;
110 :     }
111 :     }
112 :     }
113 :     }
114 :    
115 :     # now generate the labels
116 :     my $display;
117 :     foreach my $sf (@pirsf) {
118 :     next unless ($sf);
119 : redwards 1.2 my $displayname=$pirid->{$sf};
120 : redwards 1.1 if (length($displayname) > 50) {$displayname=substr($displayname, 0, 50)}
121 : redwards 1.2 if ($cgi->param('showsubsys')) {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "/". (scalar keys %{$ss->{$sf}}) . "]"}
122 :     else {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "]"}
123 : redwards 1.1 }
124 :     unshift @pirsf, ''; $display->{''}='';
125 :    
126 :     push (@$html, $cgi->start_form(-action => "pir.cgi"),
127 :     $cgi->h2("Please choose your super family"),
128 :     "First, please enter a username: ", $cgi->textfield(-name=>"user"), $cgi->p,
129 :     "The pull down list shows the PIR superfamilies. If only one number is shown (default) this is the number of PEGs that map to that superfamily. ",
130 :     "If you choose to show subsystem counts in this menu, you will get two numbers. The first of the two numbers in parenthesis is the number ",
131 :     "of PEGs that map to that superfamily, and the second number in parenthesis is the number of <em>different</em> ",
132 :     "subsystems that those PEGs are in.\n", $cgi->p,
133 :     $cgi->popup_menu(-name=>'pirsf', -values=>[keys %$display], -labels=>$display), $cgi->p,
134 :     "\nMinimum number of pegs per PIR superfamily shown in list &nbsp; <input type='text' name='min' value='$min' size=3 />",
135 :     "or show all PIR superfamilies: ", $cgi->checkbox(-name=>"showall", -label=>""), $cgi->p,
136 :     $cgi->checkbox(-name=>"showsubsys", -label=>"Show subsystem counts in pull down menu (this will slow things down!)"), $cgi->p,
137 :     $cgi->checkbox(-name=>"preliminary", -label=>"Show only preliminary PIR superfamilies"), $cgi->p,
138 :     $cgi->submit('submit', 'Update view'),
139 :     $cgi->submit('submit', 'Show Correspondance'),
140 :     $cgi->reset,
141 :    
142 :    
143 :     $cgi->end_form,
144 :     );
145 :    
146 :     }
147 :    
148 :    
149 :    
150 :     =head1 read_pir_file
151 :    
152 :     Read the PIR data file that describes superfamilies and the PIR proteins that have those families.
153 :     The PIR data file is from ftp://ftp.pir.georgetown.edu/pir_databases/pirsf/data/pirsfinfo.dat and
154 :     contains the family name beginning with a > and then a list of PIR ids.
155 :    
156 : redwards 1.2 I split this using the PIRSF\d+ and return two hashes. One that correlates PIRSF\d+ to fig id and one
157 :     that correlates it to superfamily names.
158 : redwards 1.1
159 :     =cut
160 :    
161 :     sub read_pir_file {
162 :    
163 :     # just read the file, convert it to an HTML table and return it
164 :     unless (-e "$FIG_Config::data/Global/pirsfcorrespondance.txt") {
165 :     print STDERR "Can't find the correspondance file pirsfcorrespondance.txt so we are going to make it\n";
166 :     raelib->pirsfcorrespondance("$FIG_Config::data/Global/pirsfinfo.dat", "$FIG_Config::data/Global/pirsfcorrespondance.txt");
167 :     }
168 :     open (IN, "$FIG_Config::data/Global/pirsfcorrespondance.txt") || die "Can't open $FIG_Config::data/Global/pirsfcorrespondance.txt";
169 :     my $pir;
170 : redwards 1.2 my $functions;
171 :     my $id;
172 : redwards 1.1 my $added;
173 :     while (<IN>) {
174 :     chomp;
175 :     if (s/^>//) {
176 :     unless ($added) {
177 :     # we didn't find anything that maps here
178 : redwards 1.2 $pir->{$id}=undef;
179 : redwards 1.1 }
180 : redwards 1.2 /^(PIRSF\d+)\s+(.*?)$/;
181 :     $id=$1;
182 :     $functions->{$id}=$2;
183 : redwards 1.1 undef $added;
184 :     }
185 :     else {
186 : redwards 1.2 my ($pirid, $peg)=split /\t/;
187 : redwards 1.1 next unless ($peg);
188 : redwards 1.2 push @{$pir->{$id}}, $peg;
189 : redwards 1.1 $added=1;
190 :     }
191 :     }
192 : redwards 1.2 return $pir, $functions;
193 : redwards 1.1 }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3