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

Annotation of /FigWebServices/sdk_uniprot_search.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (view) (download)

1 : mkubal 1.1 #use SOAP::Lite +trace;
2 :     use SOAP::Lite;
3 :    
4 :     use Classes;
5 :    
6 :     use HTML;
7 :     use CGI;
8 :     use HTML;
9 :     use FIG;
10 :     use FIG_Config;
11 :    
12 :     my $cgi = new CGI;
13 :     my $fig = new FIG;
14 :     my $html = [];
15 :     my $search_term;
16 :    
17 : mkubal 1.4 eval{
18 :     my $soap = SOAP::Lite
19 :     -> readable(1)
20 :     -> service('http://armstrong.arc.georgetown.edu:8081/gridPIR4/ws/PIRDataServices?wsdl');
21 :     };
22 :    
23 :     &build_no_connection_page($fig,$cgi,$html) if $@;
24 :    
25 : mkubal 1.6 my $number_of_results;
26 :    
27 :     if( $cgi->param('limit_search_results') ){
28 :     $number_of_results = $cgi->param('limit_search_results');
29 :     }
30 :     else{
31 :     $number_of_results = 100;
32 :     }
33 :    
34 : mkubal 1.4
35 : mkubal 1.1 if ($cgi->param('request') eq "Search"){
36 :     $search_term = $cgi->param('search_term');
37 : mkubal 1.6 &search($fig,$cgi,$html,$search_term,$number_of_results);
38 : mkubal 1.1 }
39 :    
40 :     else{
41 :     &build_page($fig,$cgi,$html);
42 :     }
43 :    
44 :     sub search{
45 :    
46 : mkubal 1.6 my($fig,$cgi,$html,$search_term,$number_of_results) = @_;
47 : mkubal 1.1 my $rows = [];
48 :    
49 : mkubal 1.2 #$search_term = "*".$search_term."*";
50 : mkubal 1.1 #getting Protein attributes via Gene - works
51 :    
52 : mkubal 1.7 if ($cgi->param('select_domain') eq "Gene Name or Symbol"){
53 : mkubal 1.1 my $criteria = GeneImpl->new(undef,$search_term,undef);
54 : mkubal 1.6 my $r = doQuery("ProteinImpl,edu.georgetown.pir.domain.ws.GeneImpl", $criteria, "GeneImpl", 0, $number_of_results);
55 : mkubal 1.1 my @ids_via_gene = ();
56 :     for my $pi ( @{$r} ) {
57 : mkubal 1.4 #if($pi eq "no_connection"){&problem($cgi,$html)}
58 : mkubal 1.1 my $id = $pi->{uniprotkbPrimaryAccession};
59 :     print STDERR "via gene: $id\n";
60 :     my $row = &build_row($id);
61 :     push(@$rows,$row);
62 :     }
63 :    
64 :     }
65 :    
66 : mkubal 1.6 elsif($cgi->param('select_domain') eq "UniProt Primary Accession"){
67 : mkubal 1.1 my $criteria = ProteinImpl->new(undef, $search_term, undef);
68 : mkubal 1.6 my $r = doQuery("ProteinImpl", $criteria, "ProteinImpl", 0, $number_of_results);
69 : mkubal 1.1 for my $pi ( @{$r} ) {
70 :     my $id = $pi->{uniprotkbPrimaryAccession};
71 :     my $row = &build_row($id);
72 :     push(@$rows,$row);
73 :     }
74 :     }
75 :    
76 :    
77 :     elsif($cgi->param('select_domain') eq "ProteinName"){
78 :     my $criteria = ProteinNameImpl->new(undef, undef, $search_term);
79 : mkubal 1.6 my $r = doQuery("ProteinImpl,edu.georgetown.pir.domain.ws.ProteinNameImpl", $criteria, "ProteinNameImpl", 0, $number_of_results);
80 : mkubal 1.1 for my $pi ( @{$r} ){
81 :     my $id = $pi->{uniprotkbPrimaryAccession};
82 :     print STDERR "via pn: $id\n";
83 :     my $row = &build_row($id);
84 :     push(@$rows,$row);
85 :     }
86 :     }
87 :    
88 :    
89 :     else{
90 :    
91 :     my $criteria = GeneImpl->new(undef,$search_term,undef);
92 : mkubal 1.6 my $r = doQuery("ProteinImpl,edu.georgetown.pir.domain.ws.GeneImpl", $criteria, "GeneImpl", 0, $number_of_results);
93 : mkubal 1.1 my @ids_via_gene = ();
94 :     for my $pi ( @{$r} ) {
95 :     my $id = $pi->{uniprotkbPrimaryAccession};
96 :     print STDERR "via gene: $id\n";
97 :     my $row = &build_row($id);
98 :     push(@$rows,$row);
99 :     }
100 :    
101 :     #getting Protein attributes via ProteinName - works
102 :     my $criteria = ProteinNameImpl->new(undef, undef, $search_term);
103 : mkubal 1.6 my $r = doQuery("ProteinImpl,edu.georgetown.pir.domain.ws.ProteinNameImpl", $criteria, "ProteinNameImpl", 0, $number_of_results);
104 : mkubal 1.1 for my $pi ( @{$r} ){
105 :     my $id = $pi->{uniprotkbPrimaryAccession};
106 :     print STDERR "via pn: $id\n";
107 :     my $row = &build_row($id);
108 :     push(@$rows,$row);
109 :     }
110 :    
111 :     #getting Protein Attributes directly from Protein Domain - works
112 :     my $criteria = ProteinImpl->new(undef, $search_term, undef);
113 : mkubal 1.6 my $r = doQuery("ProteinImpl", $criteria, "ProteinImpl", 0, $number_of_results);
114 : mkubal 1.1 for my $pi ( @{$r} ) {
115 :     my $id = $pi->{uniprotkbPrimaryAccession};
116 :     my $row = &build_row($id);
117 :     push(@$rows,$row);
118 :     }
119 :     }
120 :    
121 :    
122 :     $search_result_col_hdrs =["Fig ID","UniProtKB Primary Accession ID","Gene Names","Protein Names","Organisms"];
123 :    
124 :     #$rows = [["test1","test2","test3","test4"]];
125 :     push @$html,
126 : mkubal 1.6 $cgi->start_form(),
127 : mkubal 1.1 $cgi->hr,
128 :     &HTML::make_table($search_result_col_hdrs,$rows),
129 :     $cgi->end_form();
130 :     &HTML::show_page($cgi,$html,1);
131 :    
132 :     exit(0);
133 :    
134 :     }
135 :    
136 :     ########################################################################
137 :    
138 : mkubal 1.4 sub build_no_connection_page {
139 :     my ($fig,$cgi,$html)=@_;
140 :     push @$html,
141 : mkubal 1.6 $cgi->start_form(),
142 : mkubal 1.4 "<h2>UniProt web-service search temporarily unavailbale, please try again later</h2>",
143 :     $cgi->end_form;
144 :     &HTML::show_page($cgi,$html,1);
145 :     exit;
146 :     }
147 :    
148 :    
149 : mkubal 1.1 sub build_page {
150 :     my ($fig,$cgi,$html)=@_;
151 :     push @$html,
152 : mkubal 1.6 $cgi->start_form(),
153 : mkubal 1.3 "<h2>Search UniProt</h2>",
154 : mkubal 1.1 $cgi->br,
155 : mkubal 1.2 "<h4>Enter Search Term (prefix and/or append term with * for partial matches)</h4>",
156 : mkubal 1.6 $cgi->textfield(-name => 'search_term', -size => 20),
157 : mkubal 1.1 $cgi->submit(-name=>'request', -value=>'Search'),
158 :     $cgi->br,
159 :     "<h4>Limit Search to One Domain (for faster response)</h4>",
160 :     "<select name=select_domain>
161 : mkubal 1.2 <option value=All > All 3</option>
162 : mkubal 1.7 <option value=Gene >Gene Name or Symbol</option>
163 : mkubal 1.6 <option value=Protein >UniProt Primary Accession</option>
164 : mkubal 1.1 <option value=ProteinName >ProteinName</option>
165 :     </select> &nbsp;&nbsp",
166 : mkubal 1.6 $cgi->br,
167 :     "<h4>Limit Number of Search Results (default = maximum of 100)</h4>",
168 :     $cgi->textfield(-name => 'limit_search_results', -size => 20),
169 :     $cgi->br,
170 :     $cgi->end_form;
171 : mkubal 1.1 &HTML::show_page($cgi,$html,1);
172 :     exit;
173 :     }
174 :    
175 :     sub doQuery{
176 :     my ($target, $criteria, $crit_type, $max, $min) = @_;
177 :     my $pirns = "urn:ws.domain.pir.georgetown.edu";
178 : mkubal 1.4
179 : mkubal 1.1 my $soap = SOAP::Lite
180 :     -> readable(1)
181 :     -> service('http://armstrong.arc.georgetown.edu:8081/gridPIR4/ws/PIRDataServices?wsdl');
182 :    
183 : mkubal 1.4
184 : mkubal 1.1 # Notice the user of type and attr to make sure the SOAP
185 :     # matches the WSDL for the service. It looks like SOAP:Lite
186 :     # is smart enough to use the WSDL to paint the "edu.georgetown..."
187 :     # with the right element name, but for the criteria object,
188 :     # the WSDL says any_type, but we need to say what was actually
189 :     # sent. I think that's why I end up having to do this. Notice
190 :     # I don't set the element name...that's correctly being set by
191 :     # the soap::lite serializer.
192 :    
193 :     my $x = $soap->query( "edu.georgetown.pir.domain.ws." . $target,
194 :     SOAP::Data->type("pirns:$crit_type")
195 :     ->attr({'xmlns:pirns' => "$pirns"})
196 :     ->value($criteria),
197 :     $max,
198 :     $min);
199 :    
200 : mkubal 1.4
201 : mkubal 1.1 # have to do this to actually get SOM, else just get one element
202 :    
203 :     my $som = $soap->call;
204 :     #print "SOM Dump:\n" . &Dumper( $som ) . "\n";
205 :    
206 :     # Result is array of blessed objects if we pull it out of the
207 :     # SOM correctly. I think this will work for any SDK call but
208 :     # not sure.
209 :    
210 :     my @r;
211 :    
212 :     for my $t ($som->valueof('//queryResponse/queryReturn/queryReturn')) {
213 :     push( @r, $t );
214 :     }
215 :    
216 :     return \@r;
217 :     }
218 :    
219 :     sub build_row {
220 :    
221 :     my ($id) = @_;
222 :     my @row = ();
223 :     my @pegs = $fig->by_alias($id);
224 :    
225 :     my $fig_id = 0;
226 :     $fig_id = $pegs[0];
227 :     if(!$fig_id){
228 :     $fig_id = "no peg";
229 :     }
230 :     else{
231 : mkubal 1.6 #$prefix = $FIG_Config::cgi_url;
232 :     $prefix = "http://rat.uchicago.edu/FIG";
233 :     $url = $prefix."/protein.cgi?prot=".$fig_id."&user=";
234 : mkubal 1.1 $fig_id = "<a href='$url'>$fig_id</a>";
235 :     }
236 :     my @gene_names = ();
237 :     my @prot_names = ();
238 :    
239 :     #getting Gene attributes via Protein
240 :     my $criteria = ProteinImpl->new(undef,$id, undef,undef);
241 :     my $r = doQuery( "GeneImpl,edu.georgetown.pir.domain.ws.ProteinImpl", $criteria, "ProteinImpl", 0, 100);
242 :     my @gene_names = ();
243 :     foreach my $gi ( @{$r} ) {
244 :     my $name = $gi->{name};
245 :     push(@gene_names,$name);
246 :     }
247 :    
248 :     #getting ProteinName attributes via Protein - does work
249 :     my $criteria = ProteinImpl->new(undef,$id, undef,undef);
250 :     my $r = doQuery( "ProteinNameImpl,edu.georgetown.pir.domain.ws.ProteinImpl", $criteria, "ProteinImpl", 0, 100);
251 :     my @prot_names = ();
252 :     foreach my $pni ( @{$r} ) {
253 :     my $prot_name = $pni->{value};
254 :     push(@prot_names,$prot_name);
255 :     }
256 :    
257 :     #getting Organism attributes via Protein -
258 :     my $criteria = ProteinImpl->new(undef,$id, undef,undef);
259 :     my $r = doQuery( "OrganismImpl,edu.georgetown.pir.domain.ws.ProteinImpl", $criteria, "ProteinImpl", 0, 100);
260 :     my @common_names = ();
261 :     foreach my $o ( @{$r} ) {
262 :     my $common_name = $o->{commonName};
263 :     push(@common_names,$common_name);
264 :     }
265 :    
266 :     push(@row,$fig_id);
267 :     $url = "http://www.pir.uniprot.org/cgi-bin/upEntry?id=".$id;
268 :     $id = "<a href='$url'>$id</a>";
269 :     push(@row,$id);
270 :     my $gene_names_string = join(" ",@gene_names);
271 :     push(@row,$gene_names_string);
272 :     my $prot_names_string = join(" ",@prot_names);
273 :     push(@row,$prot_names_string);
274 :     my $common_names_string = join(" ",@common_names);
275 :     push(@row,$common_names_string);
276 :    
277 :     return \@row;
278 :    
279 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3