Bio/DB/CUTG.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::DB::CUTG
   4 #
   5 # Cared for by Richard Adams (richard.adams@ed.ac.uk)
   6 #
   7 # Copyright Richard Adams
   8 #
   9 # You may distribute this module under the same terms as perl itself
  10
  11 # POD documentation - main docs before the code
  12
  13 =head1 NAME
  14
  15 Bio::DB::CUTG - for access to the Codon usage Database
  16 at http://www.kazusa.or.jp/codon.
  17
  18 =head1 SYNOPSIS
  19
  20        use Bio::CodonUsage::Table;
  21        use Bio::DB::CUTG;
  22
  23        my $db = Bio::DB::CUTG->new(-sp =>'Pan troglodytes');
  24        my $CUT = $db->get_request();
  25
  26
  27 =head1 DESCRIPTION
  28
  29 This class retrieves and objectifies codon usage tables either from the
  30 CUTG web database . The idea is that you can initially retrieve a CUT from
  31 the web database, and write it to file in a way that can be read in
  32 later, using the Bio::CodonUsage::IO module.
  33
  34 For a web query, two parameters need to be specified: species(sp) and
  35 genetic code id (gc). The database is searched using regular
  36 expressions, therefore the full latin name must be given to specify
  37 the organism. If the species name is ambiguous the first CUT in the
  38 list is retrieved.  Defaults are Homo sapiens and 1(standard genetic
  39 code).  If you are retrieving CUTs from organisms using other genetic
  40 codes this needs to be put in as a parameter. Parameters can be
  41 entered in the constructor or in the get_web_request
  42 ()method. Allowable parameters are listed in the $QUERY_KEYS hash
  43 reference variable.
  44
  45 I intend at a later date to allow retrieval of multiple codon tables
  46 e.g., from a wildcard search.
  47
  48 =head1 SEE ALSO
  49
  50 L<Bio::Tools::CodonTable>,
  51 L<Bio::WebAgent>,
  52 L<Bio::CodonUsage::Table>,
  53 L<Bio::CodonUsage::IO>
  54
  55 =head1 FEEDBACK
  56
  57 =head2 Mailing Lists
  58
  59
  60 User feedback is an integral part of the evolution of this and other
  61 Bioperl modules. Send your comments and suggestions preferably to one
  62 of the Bioperl mailing lists.  Your participation is much appreciated.
  63
  64   bioperl-l@bioperl.org                  - General discussion
  65   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  66
  67 =head2 Reporting Bugs
  68
  69 Report bugs to the Bioperl bug tracking system to help us keep track
  70 the bugs and their resolution.  Bug reports can be submitted via the web:
  71
  72   http://bugzilla.open-bio.org/
  73
  74 =head1 AUTHORS
  75
  76 Richard Adams, Richard.Adams@ed.ac.uk
  77
  78 =head1 APPENDIX
  79
  80 The rest of the documentation details each of the object
  81 methods. Internal methods are usually preceded with a _
  82
  83 =cut
  84
  85
  86 # Let the code begin...
  87
  88
  89
  90 package Bio::DB::CUTG;
  91 use Bio::CodonUsage::IO;
  92 use IO::String;
  93 use URI::Escape;
  94 use vars qw($URL $QUERY_KEYS);
  95
  96 use base qw(Bio::WebAgent);
  97
  98 $QUERY_KEYS = {
  99                                 sp => 'full Latin species name',
 100                                 gc => 'genetic code id'
 101                          };
 102
 103 BEGIN {
 104                  $URL = "http://www.kazusa.or.jp"
 105         }
 106
 107
 108 =head2 new
 109
 110  Title   : new
 111  Usage   : my $db = Bio::DB::CUTG->new()
 112  Returns : a reference to a new Bio::DB::CUTG
 113  Args    : hash of optional values for db query
 114
 115 =cut
 116
 117 sub new {
 118         my ($class, @args ) =@_;
 119         _check_args(@args);
 120         my $self = $class->SUPER::new(@args);
 121         return $self;
 122 }
 123
 124 =head2 query_keys
 125
 126  Title   : query_keys
 127  Usage   : $db->query_keys()
 128  Purpose : To determine valid keys for parameters for db query.
 129  Returns : a reference to a hash describing valid query keys
 130  Args    : none
 131
 132 =cut
 133
 134 sub query_keys {
 135         return $QUERY_KEYS;
 136         }
 137
 138 =head2  sp
 139
 140  Title  : sp
 141  Usage  : my $sp = $db->sp();
 142  Purpose: Get/set method for species name
 143  Returns: void or species name string
 144  Args   : None or species name string
 145
 146 =cut
 147
 148 sub sp {
 149         my $self = shift;
 150         if (@_) {
 151                 my $name = shift;
 152                         $self->{'_sp'} = $name;
 153                 }
 154         return $self->{'_sp'}|| "Homo sapiens";
 155
 156 }
 157
 158 =head2  gc
 159
 160  Title  : gc
 161  Usage  : my $gc = $db->gc();
 162  Purpose: Get/set method for genetic code id
 163  Returns: void or genetic code  integer
 164  Args   : None or genetic code integer
 165
 166 =cut
 167
 168 sub gc {
 169         #### genetic code id for translations ####
 170         my $self = shift;
 171         if (@_) {
 172                 if($_[0] =~ /^\d+$/ && $_[0] >= 1 && $_[0] <=15 && $_[0] != 7
 173                                 && $_[0] != 8) {
 174                         $self->{'_gc'} = shift;
 175                         }
 176                 else {
 177                         $self->warn("invalid genetic code index - setting to standard default (1)");
 178                         $self->{'_gc'} = 1;
 179                         }
 180                 }
 181         return $self->{'_gc'} || 1; #return 1 if not defined
 182
 183         }
 184
 185
 186 =head2  get_request
 187
 188  Title  : get_request
 189  Usage  : my $cut = $db->get_request();
 190  Purpose: To query remote CUT with a species name
 191  Returns: a new codon usage table object
 192  Args   : species  name(mandatory), genetic code id(optional)
 193
 194 =cut
 195
 196 sub get_request {
 197         my ($self, @args) = @_;
 198         _check_args(@args);
 199         shift;
 200         ### can put in parameters here as well
 201         while( @_ ) {
 202         my $key = shift;
 203         $key =~ s/^-//;
 204         $self->$key(shift);
 205     }
 206         $self->url($URL);
 207
 208         ###1st of all search DB to check species exists and is unique
 209         my $nameparts =  join "+", $self->sp =~ /(\w+)/g;
 210         my $search_url = $self->url . "/codon/cgi-bin/spsearch.cgi?species="
 211                                         . $nameparts . "&c=s";
 212         my $rq = HTTP::Request->new(GET=>$search_url);
 213         my $reply = $self->request($rq);
 214     if ($reply->is_error) {
 215         $self->throw($reply->as_string()."\nError getting for url $search_url!\n");
 216     }
 217         my $content = $reply->content;
 218         return 0 unless $content;
 219     $self->debug (" reply from query is \n  $content");
 220         #####  if no matches, assign defaults - or can throw here?  ######
 221         if ($content =~ /not found/i) {
 222                 $self->warn("organism not found -selecting human [9606] as default");
 223                 $self->sp("9606");
 224                 $self->_db("gbpri");
 225         }
 226
 227         else {
 228                 my @names = $content =~ /species=([^"]+)/g;
 229                 ### get 1st species data from report ####
 230         my @dbs = $content =~ /\[([^\]]+)\]:\s+\d+/g;
 231                 ## warn if  more than 1 matching species ##
 232                 ## if multiple species retrieved, choose first one by default ##
 233         $self->throw("No names returned for $nameparts") unless @names;
 234                 if (@names >1 ){
 235                         $self->warn ("too many species - not a unique species id\n".
 236                          "selecting $names[0] using database [$dbs[0]]");
 237                 }
 238                 ### now assign species and database value
 239                 $self->sp($names[0]);
 240                 $self->_db($dbs[0]);
 241                 }
 242
 243
 244         ######## now get codon table , all defaults established now
 245
 246         ##construct URL##
 247         $nameparts = $self->sp;
 248
 249         my $CT_url = $self->url . "/codon/cgi-bin/showcodon.cgi?species="
 250                                 . $nameparts . "&aa=" . $self->gc . "&style=GCG";
 251     $self->debug("URL : $CT_url\n");
 252         ## retrieve data in html##
 253         my $rq2 = HTTP::Request->new(GET => $CT_url);
 254     $reply = $self->request($rq2);
 255     if ($reply->is_error) {
 256         $self->throw($reply->as_string()."\nError getting for url $CT_url!\n");
 257     }
 258         my $content2 = $reply->content;
 259
 260         ## strip html tags, basic but works here
 261         $content2 =~ s/<[^>]+>//sg;
 262         $content2 =~ s/Format.*//sg;
 263     $self->debug ("raw DDB table is :\n $content2");
 264
 265         ### and pass to Bio::CodonUsage::IO for parsing
 266         my $iostr = IO::String->new($content2);
 267         my $io = Bio::CodonUsage::IO->new (-fh=>$iostr);
 268
 269         ##return object ##
 270         return $io->next_data;
 271 }
 272
 273 sub _check_args {
 274
 275         ###checks parameters for matching $QUERYKEYS
 276         my @args = @_;
 277         while (my $key = lc(shift @args)) {
 278                 $key =~ s/\-//;
 279
 280                 if (!exists ($QUERY_KEYS->{$key})) {
 281                         Bio::Root::Root->throw("invalid parameter - must be one of [" .
 282                                                 (join "] [", keys %$QUERY_KEYS) . "]");
 283                 }
 284                 shift @args;
 285         }
 286 }
 287
 288 #### internal URL parameter not specifiable ######
 289 sub _db {
 290         my $self = shift;
 291         if (@_) {
 292                 $self->{'_db'} = shift;
 293                 }
 294         return $self->{'_db'};
 295 }
 296
 297 1;