t/DBTestHarness.pm

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