5 =head1 NAME - DBTestHarness.pm
9 # Add test dir to lib search path
14 my $harness = DBTestHarness->new();
16 # Load some data into the db
17 $ens_test->do_sql_file("some_data.sql");
19 # Get an Overlap db object for the test db
20 my $db = $harness->db();
24 This is a direct copy-and-paste from the Ensembl
27 It provides an encapsulation of creating, loading
28 and dropping databases for testing
34 package DBTestHarness
;
37 use Sys
::Hostname
'hostname';
42 use Bio
::DB
::SimpleDBContext
;
44 #Package variable for unique database name
47 # Default settings as a hash
50 'host' => 'localhost',
54 'schema_sql' => ['../biosql-schema/sql/biosqldb-mysql.sql'],
55 'database' => 'biosql',
56 'module' => 'Bio::DB::BioSQL::DBAdaptor'
59 # This is a list of possible entries in the config
60 # file "DBHarness.conf"
61 my %known_field = map {$_, 1} qw(
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"};
88 confess
"Don't know about db $db : are you sure you meant to say $db?";
90 foreach my $f (keys %$self) {
91 confess
"Unknown config field: '$f'" unless $known_field{$f};
94 $self->create_db() unless exists($self->{"dbname"});
101 my( $self, $value ) = @_;
104 $self->{'driver'} = $value;
106 return $self->{'driver'} || confess
"driver not set";
110 my( $self, $value ) = @_;
113 $self->{'host'} = $value;
115 return $self->{'host'};
119 my( $self, $value ) = @_;
122 $self->{'user'} = $value;
124 return $self->{'user'};
128 my( $self, $value ) = @_;
131 $self->{'port'} = $value;
133 return $self->{'port'};
137 my( $self, $value ) = @_;
140 $self->{'password'} = $value;
142 return $self->{'password'};
146 my( $self, $value ) = @_;
149 push(@
{$self->{'schema_sql'}}, $value);
151 return $self->{'schema_sql'} || confess
"schema_sql not set";
155 my( $self, $value ) = @_;
157 if($value && (! exists($self->{'dbname'}))) {
158 $self->{'dbname'} = $value;
160 $self->{'dbname'} = $self->_create_db_name()
161 unless exists($self->{'dbname'});
162 return $self->{'dbname'};
166 my( $self, $value ) = @_;
168 if($value && (! exists($self->{'database'}))) {
169 $self->{'database'} = $value;
171 return $self->{'database'};
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
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";
186 my ($self, $value) = @_;
187 $self->{'module'} = $value if ($value);
188 return $self->{'module'};
191 sub _create_db_name
{
194 my $host = hostname
();
195 my $db_name = "_test_db_${host}_$$".$counter;
196 $db_name =~ s{\W}{_}g;
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;
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");
217 push(@
{$self->{"_created_dbs"}}, $db_name);
219 $self->do_sql_file(@
{$self->schema_sql});
225 my %dbname_param = ("mysql" => "database=",
229 my $locator = 'dbi:'. $self->driver .":". $dbname_param{$self->driver()} .
231 foreach my $meth (qw{ host port
}) {
232 if (my $value = $self->$meth()) {
233 $locator .= ";$meth=$value";
241 my( $self, $no_create ) = @_;
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";
248 return $self->{'_db_handle'};
252 my( $self, $dbc ) = @_;
255 return $self->get_DBContext()->dbadaptor();
257 return Bio
::DB
::BioDB
->new(-database
=> $self->database,
259 -printerror
=> $ENV{HARNESS_VERBOSE
},
260 -verbose
=> $ENV{HARNESS_VERBOSE
},
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);
278 my( $self, @files ) = @_;
281 my $dbh = $self->db_handle;
283 foreach my $file (@files)
286 open SQL
, $file or die "Can't read SQL file '$file' : $!";
288 s/(#|--).*//; # Remove comments
289 next unless /\S/; # Skip lines which are all space
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);
307 my ($self, $statement) = @_;
308 if ($statement =~ /insert/i)
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);
317 my( $self, $file ) = @_;
318 my $dbh = $self->db_handle("no_create");
324 while(my $db_name = shift(@
{$self->{"_created_dbs"}})) {
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;
333 my $db = DBI
->connect($locator, $self->user, $self->password,
335 or warn "Can't connect to server ($locator), ".
336 "can't drop database $db_name: $@\n";
338 $dbh->do("DROP DATABASE $db_name") if $dbh;
340 $dbh->disconnect() if $dbh;
350 James Gilbert B<email> jgrg@sanger.ac.uk