[Bio] / FigKernelScripts / to_prodom.pl Repository:
ViewVC logotype

Annotation of /FigKernelScripts/to_prodom.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : hwang 1.1 #!/usr/bin/perl -w
2 : hwang 1.2
3 : hwang 1.1 use strict;
4 : hwang 1.2 #use CGI qw(:standard);
5 :     #use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
6 : hwang 1.1 use Data::Dumper;
7 :     use LWP;
8 :     use HTTP::Request::Common;
9 :     use FIG;
10 :     use HTML;
11 :    
12 :     my $fig = new FIG;
13 :     my $user_agent = LWP::UserAgent->new;
14 : hwang 1.2 my $usage = "usage: to_prodom [peg pegID]";
15 :     my @arguments_in;
16 :     my $arguments_in;
17 :     my $temp;
18 :    
19 :     if (@ARGV > 0)
20 :     {
21 :     @arguments_in = @ARGV;
22 :     }
23 :     else
24 :     {
25 :     die $usage;
26 :     }
27 :    
28 :     my %arg_pairs = ();
29 : hwang 1.1
30 : hwang 1.2 foreach (@arguments_in)
31 :     {
32 :     my ($name,$val) = split(/\t/,$_);
33 :     $arg_pairs{$name} = $val;
34 :     }
35 :    
36 :     my @keys = keys %arg_pairs;
37 : hwang 1.1
38 : hwang 1.2 my $peg = $arg_pairs{'peg'};
39 : hwang 1.1
40 :     $peg =~ s/\%7C/\|/g;
41 : hwang 1.2
42 :    
43 : hwang 1.1 my $seq = $fig->get_translation($peg);
44 :     my @aliases=$fig->feature_aliases($peg);
45 :    
46 :     my @sp_ids = grep {/.*sp.*/} @aliases;
47 :     my @tr_ids = grep {/.*tr.*/} @aliases;
48 :     my @uni_ids = grep {/.*uni.*/} @aliases;
49 :    
50 :     # Putting the ids in an array.
51 :     # Allow the program to process each one till there is a ProDom webpage
52 :     # Order of importance is sp, tr, uni
53 :    
54 :     my @all_ids;
55 :     &add_to_array (\@uni_ids);
56 :     &add_to_array (\@tr_ids);
57 :     &add_to_array (\@sp_ids);
58 :    
59 : hwang 1.2
60 : hwang 1.1 foreach (@all_ids) {
61 : hwang 1.2
62 : hwang 1.1 &to_prodom_by_id($_);
63 :     }
64 :    
65 :    
66 :     # If made it this far, use sequence to get the Prodom website
67 : hwang 1.2
68 :     #&to_prodom_by_seq;
69 : hwang 1.1
70 :     ###############
71 :     # Subroutines
72 :     ###############
73 :    
74 :    
75 :     sub add_to_array {
76 :     my ($x) = @_;
77 :     for (my $i=0; $i <@$x; $i++){
78 :     push @all_ids, $x->[$i];
79 :     }
80 :     }
81 :    
82 :    
83 :     sub to_prodom_by_id {
84 :    
85 :     my $id = $_;
86 :    
87 :     if ( $id ne "") {
88 :     # Remove all the identifier before |
89 :    
90 :     my $url_id = $id;
91 :     $url_id =~ s/sp\|//g;
92 :     $url_id =~ s/uni\|//g;
93 :     $url_id =~ s/tr\|//g;
94 :    
95 :     my $url = "http://protein.toulouse.inra.fr/prodom/current/cgi-bin/request.pl?question=SPTR&query=$url_id&bool_operator=OR";
96 :    
97 :    
98 :     # Pre-Check to see if there's no entry in ProDom. If there are no entry for the specified id,
99 :     # then it will go to the next id;
100 :    
101 :     my $response = $user_agent->get( $url );
102 :     die "Can't get $url -- ", $response->status_line
103 :     unless $response->is_success;
104 :    
105 :     if(! ($response->content =~ m/Sorry/i) ) {
106 :     my $result = $response->content;
107 :     # Replace relative paths with absolute paths
108 :     $result =~ s/\.\./http:\/\/prodes\.toulouse\.inra\.fr\/prodom\/current\//g;
109 : hwang 1.2
110 :     #Get rid of css reference because it breaks the FIG header
111 :     $result =~ s/<link rel=.*?>//g;
112 : hwang 1.1 print $result;
113 :     exit;
114 :     }
115 :     }
116 :     }
117 :    
118 :     sub to_prodom_by_seq {
119 :    
120 :     my $url = "http://protein.toulouse.inra.fr/prodom/current/cgi-bin/ProDomBlast3.pl";
121 :     my $request = POST( $url,
122 :     Content_Type => 'form-data',
123 :     Content => [ 'matrice' => 'BLOSUM62',
124 :     'program' => 'ncbi-blastp',
125 :     'typebd' => 'multiple alignments',
126 :     'expect' => '.01',
127 :     'filtre' => 'seq',
128 :     'nom_seq' => '',
129 :     'sequence' => $seq,
130 :     ]
131 :     );
132 :    
133 :    
134 :     my $response = $user_agent->request($request);
135 :     my $result = $response->content;
136 :     # Replace relative paths with absolute paths
137 :     $result =~ s/\.\./http:\/\/prodes\.toulouse\.inra\.fr\/prodom\/current\//g;
138 : hwang 1.2 $result =~ s/<link rel=.*?>//g;
139 : hwang 1.1 print $result;
140 : hwang 1.2
141 : hwang 1.1 }
142 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3