t/BioSQLBase.pm

   1 # $Id$
   2
   3 #
   4 # (c) Hilmar Lapp, hlapp at gnf.org, 2002.
   5 # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
   6 #
   7 # You may distribute this module under the same terms as perl itself.
   8 # Refer to the Perl Artistic License (see the license accompanying this
   9 # software package, or see http://www.perl.com/language/misc/Artistic.html)
  10 # for the terms under which you may use, modify, and redistribute this module.
  11 #
  12 # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  13 # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  14 # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  15 #
  16
  17 =head1 NAME - BioSQL-base.pm
  18
  19 =head1 SYNOPSIS
  20
  21     # synopsis goes here
  22
  23 =head1 DESCRIPTION
  24
  25 This modules provides methods to insert and remove the parent entities
  26 needed by many (probably all) of the different tests for child
  27 entities.
  28
  29 =head1 AUTHOR Hilmar Lapp
  30
  31 Email hlapp at gnf.org
  32
  33 =cut
  34
  35 package BioSQLBase;
  36
  37 use lib 't';
  38
  39 use strict;
  40 use vars qw(@ISA $VERSION);
  41
  42 use Bio::Root::Root;
  43 use DBTestHarness;
  44
  45 @ISA = qw(Bio::Root::Root);
  46
  47 =head2 store_seq
  48
  49  Title   : store_seq
  50  Usage   : $seq = $biosql->store_seq($stream, "rodent");
  51  Function: Reads the next sequence from the given Bio::SeqIO stream and
  52            stores it under the namespace given by 2nd argument.
  53  Returns : The sequence object that was stored, with the PK in
  54            $seq->primary_id(), and undef if there was no sequence in the stream
  55  Args    : SeqIO stream (object) and namespace (a string)
  56
  57 =cut
  58
  59 sub store_seq {
  60     my ($self, $seqio, $namespace) = @_;
  61
  62     my $seq = $seqio->next_seq();
  63     return unless $seq;
  64     my $biodbadaptor = $self->db()->get_BioDatabaseAdaptor;
  65     my $bdbid = $biodbadaptor->fetch_by_name_store_if_needed($namespace);
  66     my $seqadaptor = $self->db()->get_SeqAdaptor;
  67     my $pk = $seqadaptor->store($bdbid, $seq);
  68     $seq->primary_id($pk);
  69     return $seq;
  70 }
  71
  72 =head2 delete_seq
  73
  74  Title   : delete_seq
  75  Usage   : $ok = $biosql->delete_seq($seq);
  76  Function: Deletes the given sequence from the database.
  77  Returns : True for success and false otherwise.
  78  Args    : A Bio::PrimarySeqI compliant object
  79
  80 =cut
  81
  82 sub delete_seq {
  83     my ($self, $seq) = @_;
  84
  85     my $seqadaptor = $self->db()->get_SeqAdaptor;
  86     return $seqadaptor->remove_by_dbID($seq->primary_id());
  87 }
  88
  89 =head2 delete_biodatabase
  90
  91  Title   : delete_biodatabase
  92  Usage   : $ok = $biosql->delete_biodatabase($biodatabase);
  93  Function: Deletes the given biodatabase (namespace) from the database.
  94  Returns : True for success and false otherwise.
  95  Args    : namespace (a string)
  96
  97 =cut
  98
  99 sub delete_biodatabase {
 100     my ($self, $namespace) = @_;
 101
 102     my $biodbadaptor = $self->db()->get_BioDatabaseAdaptor;
 103     return $biodbadaptor->remove_by_name($namespace);
 104 }
 105
 106 =head2 db
 107
 108  Title   : db
 109  Usage   : $dbadaptor = $biosql->db();
 110  Function:
 111  Returns : The DBAdaptor object in use to wrap the BioSQL database.
 112  Args    : On set (optional), the DBAdaptor object to be used.
 113
 114 =cut
 115
 116 sub db {
 117     my ($self, $db) = @_;
 118
 119     if($db) {
 120         $self->{'_db'} = $db;
 121     }
 122     if(! exists($self->{'_db'})) {
 123         $self->{'_db'} = $self->dbharness()->get_DBAdaptor(); # we cache this!
 124     }
 125     return $self->{'_db'};
 126 }
 127
 128 =head2 dbharness
 129
 130  Title   : dbharness
 131  Usage   : $dbharness = $biosql->dbharness();
 132  Function:
 133  Returns : The DBTestHarness object in use.
 134  Args    : On set (optional), the DBTestHarness object to be used.
 135
 136 =cut
 137
 138 sub dbharness {
 139     my ($self, $dbharness) = @_;
 140
 141     if($dbharness) {
 142         $self->{'_dbharness'} = $dbharness;
 143     }
 144     if(! exists($self->{'_dbharness'})) {
 145         $self->{'_dbharness'} = DBTestHarness->new("biosql");
 146     }
 147     return $self->{'_dbharness'};
 148 }
 149
 150 1;
 151
 152 __END__
 153