t/DBTestHarness.pm

   1 # $Id$
   2
   3 =pod
   4
   5 =head1 NAME - DBTestHarness.pm
   6
   7 =head1 SYNOPSIS
   8
   9     # Add test dir to lib search path
  10     use lib 't';
  11
  12     use DBTestHarness;
  13
  14     my $harness = DBTestHarness->new();
  15
  16     # Load some data into the db
  17     $ens_test->do_sql_file("some_data.sql");
  18
  19     # Get an Overlap db object for the test db
  20     my $db = $harness->db();
  21
  22 =head1 DESCRIPTION
  23
  24 This is a direct copy-and-paste from the Ensembl
  25 EnsTestDB system.
  26
  27 It provides an encapsulation of creating, loading
  28 and dropping databases for testing
  29
  30 =head1 METHODS
  31
  32 =cut
  33
  34 package DBTestHarness;
  35
  36 use strict;
  37 use Sys::Hostname 'hostname';
  38
  39 use DBI;
  40 use Carp;
  41 use Bio::DB::BioDB;
  42 use Bio::DB::SimpleDBContext;
  43
  44 #Package variable for unique database name
  45 my $counter=0;
  46
  47 # Default settings as a hash
  48 my $dflt = {
  49     'driver'        => 'mysql',
  50     'host'          => 'localhost',
  51     'user'          => 'root',
  52     'port'          => undef,
  53     'password'      => '',
  54     'schema_sql'    => ['../biosql-schema/sql/biosqldb-mysql.sql'],
  55     'database'      => 'biosql',
  56     'module'        => 'Bio::DB::BioSQL::DBAdaptor'
  57     };
  58
  59     # This is a list of possible entries in the config
  60     # file "DBHarness.conf"
  61 my %known_field = map {$_, 1} qw(
  62         driver
  63         host
  64         user
  65         port
  66         password
  67         schema_sql
  68         dbname
  69         database
  70         module
  71         );
  72
  73 sub new {
  74     my( $pkg,$db ) = @_;
  75
  76     $counter++;
  77     my $self;
  78
  79     confess "Must provide db, no default any more" unless $db;
  80     # Get config from file, or use default values
  81     if( $db eq 'biosql' ) {
  82         $self = do 'DBHarness.biosql.conf';
  83     } elsif ( $db eq 'markerdb' ) {
  84         $self = do 'DBHarness.markerdb.conf';
  85         $self->{"schema_sql"} = ['./sql/markerdb-mysql.sql']
  86             unless $self->{"schema_sql"};
  87     } else {
  88         confess "Don't know about db $db : are you sure you meant to say $db?";
  89     }
  90     foreach my $f (keys %$self) {
  91         confess "Unknown config field: '$f'" unless $known_field{$f};
  92     }
  93     bless $self, $pkg;
  94     $self->create_db() unless exists($self->{"dbname"});
  95
  96     return $self;
  97 }
  98
  99
 100 sub driver {
 101     my( $self, $value ) = @_;
 102
 103     if ($value) {
 104         $self->{'driver'} = $value;
 105     }
 106     return $self->{'driver'} || confess "driver not set";
 107 }
 108
 109 sub host {
 110     my( $self, $value ) = @_;
 111
 112     if ($value) {
 113         $self->{'host'} = $value;
 114     }
 115     return $self->{'host'};
 116 }
 117
 118 sub user {
 119     my( $self, $value ) = @_;
 120
 121     if ($value) {
 122         $self->{'user'} = $value;
 123     }
 124     return $self->{'user'};
 125 }
 126
 127 sub port {
 128     my( $self, $value ) = @_;
 129
 130     if ($value) {
 131         $self->{'port'} = $value;
 132     }
 133     return $self->{'port'};
 134 }
 135
 136 sub password {
 137     my( $self, $value ) = @_;
 138
 139     if ($value) {
 140         $self->{'password'} = $value;
 141     }
 142     return $self->{'password'};
 143 }
 144
 145 sub schema_sql {
 146     my( $self, $value ) = @_;
 147
 148     if ($value) {
 149         push(@{$self->{'schema_sql'}}, $value);
 150     }
 151     return $self->{'schema_sql'} || confess "schema_sql not set";
 152 }
 153
 154 sub dbname {
 155     my( $self, $value ) = @_;
 156
 157     if($value && (! exists($self->{'dbname'}))) {
 158         $self->{'dbname'} = $value;
 159     }
 160     $self->{'dbname'} = $self->_create_db_name()
 161         unless exists($self->{'dbname'});
 162     return $self->{'dbname'};
 163 }
 164
 165 sub database {
 166     my( $self, $value ) = @_;
 167
 168     if($value && (! exists($self->{'database'}))) {
 169         $self->{'database'} = $value;
 170     }
 171     return $self->{'database'};
 172 }
 173
 174 # convenience method: by calling it, you get the name of the database,
 175 # which  you can cut-n-paste into another window for doing some mysql
 176 # stuff interactively
 177 sub pause {
 178     my ($self) = @_;
 179     my $db = $self->{'_dbname'};
 180     print STDERR "pausing to inspect database; name of database is:  $db\n";
 181     print STDERR "press ^D to continue\n";
 182     while(<>) { 1; }
 183 }
 184
 185 sub module {
 186     my ($self, $value) = @_;
 187     $self->{'module'} = $value if ($value);
 188     return $self->{'module'};
 189 }
 190
 191 sub _create_db_name {
 192     my( $self ) = @_;
 193
 194     my $host = hostname();
 195     my $db_name = "_test_db_${host}_$$".$counter;
 196     $db_name =~ s{\W}{_}g;
 197     return $db_name;
 198 }
 199
 200 sub create_db {
 201     my( $self ) = @_;
 202
 203     ### FIXME: not portable between different drivers
 204     my $locator = 'dbi:'. $self->driver .':host='. $self->host .';';
 205     if ($self->driver eq "Pg") {
 206         # HACK! with DBD::Pg we *must* connect to a db
 207         $locator = 'dbi:Pg:dbname=template1';
 208         $locator .= ";host=".$self->host if $self->host;
 209     }
 210     print STDERR "locator:$locator\n" if $ENV{SQL_TRACE};
 211     my $db = DBI->connect(
 212         $locator, $self->user, $self->password, {RaiseError => 1}
 213         ) or confess "Can't connect to server";
 214     my $db_name = $self->dbname;
 215     $db->do("CREATE DATABASE $db_name");
 216     $db->disconnect;
 217     push(@{$self->{"_created_dbs"}}, $db_name);
 218
 219     $self->do_sql_file(@{$self->schema_sql});
 220 }
 221
 222 sub test_locator {
 223     my( $self ) = @_;
 224
 225     my %dbname_param = ("mysql"  => "database=",
 226                         "Pg"     => "dbname=",
 227                         "Oracle" => "");
 228
 229     my $locator = 'dbi:'. $self->driver .":". $dbname_param{$self->driver()} .
 230         $self->dbname;
 231     foreach my $meth (qw{ host port }) {
 232         if (my $value = $self->$meth()) {
 233             $locator .= ";$meth=$value";
 234         }
 235     }
 236     return $locator;
 237 }
 238
 239
 240 sub db_handle {
 241     my( $self, $no_create ) = @_;
 242
 243     unless ($self->{'_db_handle'} || $no_create) {
 244         $self->{'_db_handle'} = DBI->connect(
 245             $self->test_locator, $self->user, $self->password, {RaiseError => 1}
 246             ) or confess "Can't connect to server";
 247     }
 248     return $self->{'_db_handle'};
 249 }
 250
 251 sub get_DBAdaptor {
 252     my( $self, $dbc ) = @_;
 253
 254     if(! $dbc) {
 255         return $self->get_DBContext()->dbadaptor();
 256     }
 257     return Bio::DB::BioDB->new(-database   => $self->database,
 258                                -dbcontext  => $dbc,
 259                                -printerror => $ENV{HARNESS_VERBOSE},
 260                                -verbose    => $ENV{HARNESS_VERBOSE},
 261                                );
 262 }
 263
 264 sub get_DBContext {
 265     my ($self) = @_;
 266     my $dbc = Bio::DB::SimpleDBContext->new("-driver" => $self->driver,
 267                                             "-dbname" => $self->dbname,
 268                                             "-host"   => $self->host,
 269                                             "-user"   => $self->user,
 270                                             "-pass"   => $self->password,
 271                                             "-port"   => $self->port);
 272     my $dbadp = $self->get_DBAdaptor($dbc);
 273     $dbc->dbadaptor($dbadp);
 274     return $dbc;
 275 }
 276
 277 sub do_sql_file {
 278     my( $self, @files ) = @_;
 279     local *SQL;
 280     my $i = 0;
 281     my $dbh = $self->db_handle;
 282
 283     foreach my $file (@files)
 284     {
 285         my $sql = '';
 286         open SQL, $file or die "Can't read SQL file '$file' : $!";
 287         while (<SQL>) {
 288             s/(#|--).*//;       # Remove comments
 289             next unless /\S/;   # Skip lines which are all space
 290             $sql .= $_;
 291             $sql .= ' ';
 292         }
 293         close SQL;
 294
 295         #Modified split statement, only semicolumns before end of line,
 296         #so we can have them inside a string in the statement
 297         foreach my $s (grep /\S/, split /;\n/, $sql) {
 298             $self->validate_sql($s);
 299             $dbh->do($s);
 300             $i++
 301         }
 302     }
 303     return $i;
 304 }
 305
 306 sub validate_sql {
 307     my ($self, $statement) = @_;
 308     if ($statement =~ /insert/i)
 309     {
 310         $statement =~ s/\n/ /g; #remove newlines
 311         die ("INSERT should use explicit column names (-c switch in mysqldump)\n$statement\n")
 312             unless ($statement =~ /insert.+into.*\(.+\).+values.*\(.+\)/i);
 313     }
 314 }
 315
 316 sub DESTROY {
 317     my( $self, $file ) = @_;
 318     my $dbh = $self->db_handle("no_create");
 319
 320     if($dbh) {
 321         $dbh->disconnect;
 322         $dbh = undef;
 323     }
 324     while(my $db_name = shift(@{$self->{"_created_dbs"}})) {
 325         if(! $dbh) {
 326             ### FIXME: not portable between different drivers
 327             my $locator = 'dbi:'. $self->driver .':host='. $self->host .';';
 328             if ($self->driver eq "Pg") {
 329                 # HACK! with DBD::Pg we *must* connect to a db
 330                 $locator = 'dbi:Pg:dbname=template1';
 331                 $locator .= ";host=".$self->host if $self->host;
 332             }
 333             my $db = DBI->connect($locator, $self->user, $self->password,
 334                                   {RaiseError => 0})
 335                 or warn "Can't connect to server ($locator), ".
 336                         "can't drop database $db_name: $@\n";
 337         }
 338         $dbh->do("DROP DATABASE $db_name") if $dbh;
 339     }
 340     $dbh->disconnect() if $dbh;
 341 }
 342
 343 1;
 344
 345
 346 __END__
 347
 348 =head1 AUTHOR
 349
 350 James Gilbert B<email> jgrg@sanger.ac.uk