lib/Bio/DB/BioSQL/OBDA.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::DB::BioSQL::OBDA
   4 #
   5 # Copyright Brian Osborne
   6 #
   7 # You may distribute this module under the same terms as perl itself
   8
   9 # POD documentation - main docs before the code
  10
  11 =head1 NAME
  12
  13 Bio::DB::BioSQL::OBDA
  14
  15 =head1 SYNOPSIS
  16
  17 This module is meant to be used a part of the OBDA system, e.g.:
  18
  19   use Bio::DB::Registry;
  20
  21   my $registry = Bio::DB::Registry->new;
  22   my $db = $registry->get_database('biosql');
  23   my $seq = $db->get_Seq_by_acc('P41932');
  24
  25 =head1 DESCRIPTION
  26
  27 This module connects code that uses OBDA to the bioperl-db package
  28 and the underlying BioSQL database.
  29
  30 The Open Biological Database Access (OBDA) system was designed so that one
  31 could use the same application code to access data from multiple database
  32 types by simply changing a few lines in a configuration file. See
  33 L<http://www.bioperl.org/wiki/HOWTO:OBDA> for more information.
  34
  35 =head1 FEEDBACK
  36
  37 =head2 Mailing Lists
  38
  39 User feedback is an integral part of the evolution of this
  40 and other Bioperl modules. Send your comments and suggestions preferably
  41 to one of the Bioperl mailing lists.
  42 Your participation is much appreciated.
  43
  44   bioperl-l@bio.perl.org
  45
  46 =head2 Support
  47
  48 Please direct usage questions or support issues to the mailing list:
  49
  50 I<bioperl-l@bioperl.org>
  51
  52 rather than to the module maintainer directly. Many experienced and
  53 reponsive experts will be able look at the problem and quickly
  54 address it. Please include a thorough description of the problem
  55 with code and data examples if at all possible.
  56
  57 =head2 Reporting Bugs
  58
  59 Report bugs to the Bioperl bug tracking system to help us keep track
  60 the bugs and their resolution. Bug reports can be submitted via the web:
  61
  62   http://redmine.open-bio.org/projects/bioperl
  63
  64 =head1 AUTHOR - Brian Osborne
  65
  66 Email bosborne at alum.mit.edu
  67
  68 =head1 APPENDIX
  69
  70 The rest of the documentation details each of the object methods. Internal
  71 methods are usually preceded with a _
  72
  73 =cut
  74
  75 # Let the code begin...
  76
  77 package Bio::DB::BioSQL::OBDA;
  78 use strict;
  79 use Bio::DB::Query::BioQuery;
  80 use Bio::DB::BioDB;
  81 use base qw(Bio::Root::Root Bio::DB::RandomAccessI);
  82
  83 =head2 new_from_registry
  84
  85  Title   : new_from_registry
  86  Usage   :
  87  Function: Create a database object that can be used by OBDA
  88  Returns :
  89  Args    : Hash containing connection parameters read from an OBDA
  90            registry file
  91
  92 =cut
  93
  94 sub new_from_registry {
  95    my ($class, %conf) = @_;
  96         my $self = $class->SUPER::new();
  97         my ($host,$port);
  98         #  prevent warning msg by allowing location to be undef for postgresql 'ident sameuser' login)
  99         if (defined $conf{'location'}) {
 100                 ($host,$port) = split ":", $conf{'location'};
 101         }
 102         my $db = Bio::DB::BioDB->new( -database => 'biosql',
 103                                                                                   -host     => $host,
 104                                                                                   -port     => $port,
 105                                                                                   -dbname   => $conf{'dbname'},
 106                                                                                   -driver   => $conf{'driver'},
 107                                       -user     => $conf{'user'  },
 108                                                                                   -pass     => $conf{'passwd'} );
 109         $self->_db($db);
 110         $self;
 111 }
 112
 113 =head1 Methods inherited from Bio::DB::RandomAccessI
 114
 115 =head2 get_Seq_by_id
 116
 117  Title   : get_Seq_by_id
 118  Usage   : $seq = $db->get_Seq_by_id(12345)
 119  Function:
 120  Example :
 121  Returns : One or more Sequence objects
 122  Args    : An identifier
 123
 124 =cut
 125
 126 sub get_Seq_by_id {
 127     my ($self,$id) = @_;
 128     my $db = $self->_db;
 129     my @seqs = ();
 130     $self->throw("No identifier given") unless $id;
 131
 132     my $query = $self->{'_byId_Query'};
 133     if (! $query) {
 134         $query = Bio::DB::Query::BioQuery->new(
 135             -datacollections => ['Bio::SeqI seq'],
 136             -where => ["seq.primary_id = ?"]);
 137         $self->{'_byId_Query'} = $query;
 138     }
 139     my $seq_adaptor = $db->get_object_adaptor('Bio::SeqI');
 140     my $result = $seq_adaptor->find_by_query($query,
 141                                              '-name' => 'OBDA get_Seq_by_id',
 142                                              '-values' => [$id]);
 143
 144     for my $seq ($result->next_object) {
 145         push @seqs,$seq;
 146     }
 147     return wantarray ? @seqs : $seqs[0];
 148 }
 149
 150 =head2 get_Seq_by_acc
 151
 152  Title   : get_Seq_by_acc
 153  Usage   : $seq = $db->get_Seq_by_acc('A12345')
 154  Function:
 155  Example :
 156  Returns : One or more Sequence objects
 157  Args    : An accession number
 158
 159 =cut
 160
 161 sub get_Seq_by_acc {
 162     my ($self,$acc) = @_;
 163     my $db = $self->_db;
 164     my @seqs = ();
 165     $self->throw("No accession given") unless $acc;
 166
 167     my $query = $self->{'_byAcc_Query'};
 168     if (! $query) {
 169         $query = Bio::DB::Query::BioQuery->new(
 170             -datacollections => ['Bio::SeqI seq'],
 171             -where => ["seq.accession_number = ?"]);
 172         $self->{'_byAcc_Query'} = $query;
 173     }
 174     my $seq_adaptor = $db->get_object_adaptor('Bio::SeqI');
 175     my $result = $seq_adaptor->find_by_query($query,
 176                                              '-name' => "OBDA get_Seq_by_acc",
 177                                              '-values' => [$acc]);
 178
 179     for my $seq ($result->next_object) {
 180         push @seqs,$seq;
 181     }
 182     return wantarray ? @seqs : $seqs[0];
 183 }
 184
 185 =head2 get_Seq_by_version
 186
 187  Title   : get_Seq_by_version
 188  Usage   : $seq = $db->get_Seq_by_version('A12345.3')
 189  Function:
 190  Example :
 191  Returns : One or more Sequence objects
 192  Args    : A versioned accession number
 193
 194 =cut
 195
 196 sub get_Seq_by_version {
 197     my ($self,$vacc) = @_;
 198     my $db = $self->_db;
 199     my @seqs = ();
 200     my @comps = split(/\./, $vacc); # split into components on period
 201     $self->throw("Must supply a versioned accession: <accession>.<version>")
 202         unless @comps >= 2;
 203     my $ver = pop(@comps);      # the last one is the version
 204     my $acc = join(".",@comps); # the preceding rest is the accession
 205
 206     my $query = $self->{'_byAccVersion_Query'};
 207     if (! $query) {
 208         $query = Bio::DB::Query::BioQuery->new(
 209             -datacollections => ['Bio::SeqI seq'],
 210             -where => ["seq.accession_number = ?",
 211                        "seq.version = ?"]);
 212         $self->{'_byAccVersion_Query'} = $query;
 213     }
 214     my $seq_adaptor = $db->get_object_adaptor('Bio::SeqI');
 215     my $result = $seq_adaptor->find_by_query($query,
 216                                              '-name' => "OBDA get_Seq_by_version",
 217                                              '-values' => [$acc,$ver]);
 218
 219     for my $seq ($result->next_object) {
 220         push @seqs,$seq;
 221     }
 222     return wantarray ? @seqs : $seqs[0];
 223 }
 224
 225 =head1 Private methods
 226
 227 =head2 _db
 228
 229  Title   : _db
 230  Usage   :
 231  Function: Get or set the BioDB object
 232  Example :
 233  Returns :
 234  Args    :
 235
 236 =cut
 237
 238 sub _db {
 239         my ($self,$db) = @_;
 240         $self->{_db} = $db if ($db);
 241         $self->{_db};
 242 }
 243
 244 1;
 245
 246 __END__