← Back to branch summary

~ubuntu-branches/ubuntu/saucy/bioperl/saucy-proposed

« back to all changes in this revision

Viewing changes to Bio/DB/CUTG.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
https://launchpad.net/bugs/324001
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/DB/CUTG.pm
1
 
# $Id: CUTG.pm,v 1.11.4.2 2006/10/02 23:10:14 sendu Exp $
 
1
# $Id: CUTG.pm 14525 2008-02-21 18:45:39Z cjfields $
2
2
#
3
3
# BioPerl module for Bio::DB::CUTG
4
4
#
90
90
package Bio::DB::CUTG;
91
91
use Bio::CodonUsage::IO;
92
92
use IO::String;
 
93
use URI::Escape;
93
94
use vars qw($URL $QUERY_KEYS);
94
95
 
95
96
use base qw(Bio::WebAgent);
148
149
        my $self = shift;
149
150
        if (@_) {
150
151
                my $name = shift;
151
 
                if ($name =~ /[^\w\s]/) {
152
 
                        $self->warn (" contains non-word characters, setting to default
153
 
                                                        of Homo sapiens");
154
 
                        $self->{'_sp'} = "Homo sapiens";
155
 
                                }
156
 
                else{
157
152
                        $self->{'_sp'} = $name;
158
 
                        }
159
153
                }
160
154
        return $self->{'_sp'}|| "Homo sapiens";
161
155
        
191
185
 
192
186
=head2  get_request
193
187
 
194
 
 Title  : get_web_request
195
 
 Usage  : my $cut = $db->get_web_request();
 
188
 Title  : get_request
 
189
 Usage  : my $cut = $db->get_request();
196
190
 Purpose: To query remote CUT with a species name
197
191
 Returns: a new codon usage table object 
198
192
 Args   : species  name(mandatory), genetic code id(optional)
225
219
    $self->debug (" reply from query is \n  $content");
226
220
        #####  if no matches, assign defaults - or can throw here?  ######
227
221
        if ($content =~ /not found/i) {
228
 
                $self->warn ("organism not found -selecting human as default");
229
 
                $self->sp("Homo sapiens");
 
222
                $self->warn("organism not found -selecting human [9606] as default");
 
223
                $self->sp("9606");
230
224
                $self->_db("gbpri");
231
 
        
232
225
        }
233
226
 
234
 
        
235
227
        else {
236
 
                my @names = $content =~ /(species)/g;
 
228
                my @names = $content =~ /species=([^"]+)/g;
237
229
                ### get 1st species data from report ####
238
 
                my ($sp, $db)  = $content =~ /species=(.*)\+\[(\w+)\]"/;
239
 
                
240
 
                $sp =~ s/\+/ /g;
 
230
        my @dbs = $content =~ /\[([^\]]+)\]:\s+\d+/g;
241
231
                ## warn if  more than 1 matching species ##
242
232
                ## if multiple species retrieved, choose first one by default ##
 
233
        $self->throw("No names returned for $nameparts") unless @names;
243
234
                if (@names >1 ){
244
 
                        $self->warn ("too many species - not a unique species id - selecting $sp  ");
245
 
                        }
 
235
                        $self->warn ("too many species - not a unique species id\n".
 
236
                         "selecting $names[0] using database [$dbs[0]]");
 
237
                }
246
238
                ### now assign species and database value
247
 
                $self->sp($sp);
248
 
                $self->_db($db);
 
239
                $self->sp($names[0]);
 
240
                $self->_db($dbs[0]);
249
241
                }
250
242
 
251
243
 
252
244
        ######## now get codon table , all defaults established now
253
245
 
254
246
        ##construct URL##
255
 
        $nameparts =  join "+", $self->sp =~ /(\w+)/g;
 
247
        $nameparts = $self->sp;
 
248
 
256
249
        my $CT_url = $self->url . "/codon/cgi-bin/showcodon.cgi?species="
257
 
                                . $nameparts . "+%5B" . $self->_db . "%5D&aa=" . $self->gc . "&style=GCG";
258
 
 
 
250
                                . $nameparts . "&aa=" . $self->gc . "&style=GCG";
 
251
    $self->debug("URL : $CT_url\n");
259
252
        ## retrieve data in html##
260
 
        my $rq2 = HTTP::Request->new(GET=>$CT_url);
 
253
        my $rq2 = HTTP::Request->new(GET => $CT_url);
261
254
    $reply = $self->request($rq2);
262
255
    if ($reply->is_error) {
263
256
        $self->throw($reply->as_string()."\nError getting for url $CT_url!\n");
275
268
 
276
269
        ##return object ##
277
270
        return $io->next_data;
278
 
        }
279
 
 
280
 
 
 
271
}
281
272
 
282
273
sub _check_args {
283
274