MultiTestDB.pm 24.4 KB
Newer Older
1 2
=head1 LICENSE

Magali Ruffier's avatar
Magali Ruffier committed
3
Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
Tiago Grego's avatar
Tiago Grego committed
4
Copyright [2016-2019] EMBL-European Bioinformatics Institute
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

=cut

20
package Bio::EnsEMBL::Test::MultiTestDB;
21 22 23

=pod

24 25 26
=head1 NAME

Bio::EnsEMBL::Test::MultiTestDB
27 28 29

=head1 SYNOPSIS

30 31 32 33 34 35
  my $test = Bio::EnsEMBL::Test::MultiTestDB->new(); #uses homo_sapiens by default
  my $dba = $test->get_DBAdaptor(); #uses core by default
  
  my $dros = Bio::EnsEMBL::Test::MultiTestDB->new('drosophila_melanogaster');
  my $dros_rnaseq_dba = $dros->get_DBAdaptor('rnaseq');

36 37
=head1 DESCRIPTION

38 39 40
This module automatically builds the specified database on demand and provides
a number of methods for saving, restoring and hiding databases tables in 
that database.
41

42 43 44 45 46 47
If the environment variable C<RUNTESTS_HARNESS> is set then this code will
not attempt a cleanup of the database when the object is destroyed. When used
in conjunction with C<runtests.pl> this means we create 1 database and reuse
it for all tests at the expense of test isolation. Your tests should leave the
database in a consistent state for the next test case and never assume
perfect isolation.
48

49 50 51 52 53
You can also use the env variable C<RUNTESTS_HARNESS_NORESTORE> which avoids
the running of restore() when C<RUNTESTS_HARNESS> is active. B<ONLY> use this
when you are going to destory a MultiTestDB but DBs should not be cleaned up
or restored e.g. threads. See dbEntries.t for an example of how to use it.

54 55
=cut

56
use strict;
57
use warnings;
58 59 60

use DBI;
use Data::Dumper;
61
use English qw(-no_match_vars);
62
use File::Basename;
63
use File::Copy;
64
use File::Spec::Functions;
65
use IO::File;
66
use IO::Dir;
67
use POSIX qw(strftime);
68

69
use Bio::EnsEMBL::Utils::IO qw/slurp work_with_file/;
70
use Bio::EnsEMBL::Utils::Exception qw( warning throw );
71

72 73
use base 'Test::Builder::Module';

74
$OUTPUT_AUTOFLUSH = 1;
75

76 77 78
sub diag {
  my ($self, @args) = @_;
  $self->builder()->diag(@args);
79
  return;
80 81 82 83 84
}

sub note {
  my ($self, @args) = @_;
  $self->builder()->note(@args);
85
  return;
86 87
}

88
use constant {
89 90
  # Homo sapiens is used if no species is specified
  DEFAULT_SPECIES => 'homo_sapiens',
91

92 93
  # Configuration file extension appended onto species name
  FROZEN_CONF_SUFFIX => 'MultiTestDB.frozen.conf',
94

95
  CONF_FILE => 'MultiTestDB.conf',
Andy Yates's avatar
Andy Yates committed
96
  DEFAULT_CONF_FILE => 'MultiTestDB.conf.default',
97 98
  DUMP_DIR  => 'test-genome-DBs',
  ALTERNATIVE_DUMP_DIR => 'test-Genome-DBs',
99
};
100

101 102 103 104
sub get_db_conf {
  my ($class, $current_directory) = @_;
  # Create database from local config file
  my $conf_file = catfile( $current_directory, CONF_FILE );
105
  my $db_conf = $class->_eval_file($conf_file);
106 107
  die "Error while loading config file" if ! defined $db_conf;
  
Andy Yates's avatar
Andy Yates committed
108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
  #Get the default if defined
  my $default_conf_file = catfile( $current_directory, DEFAULT_CONF_FILE );
  my $default_db_conf;
  if(-f $default_conf_file) {
    $default_db_conf = $class->_eval_file($default_conf_file);
  }
  else {
    my $tmpl = 'Cannot find the default config file at "%s"; if things do not work then this might be why';
    $class->note(sprintf($tmpl, $default_conf_file));
    $default_db_conf = {};
  }
  
  my %merged = (
    %{$default_db_conf},
    %{$db_conf},
  );
  
  return \%merged;
126 127
}

128 129
sub base_dump_dir {
  my ($class, $current_directory) = @_;
130 131 132 133 134 135 136 137
  my $dir = catdir( $current_directory, DUMP_DIR);
  if(! -d $dir) {
    my $alternative_dir = catdir($current_directory, ALTERNATIVE_DUMP_DIR);
    if(-d $alternative_dir) {
      $dir = $alternative_dir;
    }
  }
  return $dir;
138 139
}

140
sub new {
141
  my ($class, $species, $user_submitted_curr_dir, $skip_database_loading) = @_;
142

143
  my $self = bless {}, $class;
144 145 146 147 148 149
  
  #If told the current directory where config lives then use it
  if($user_submitted_curr_dir) {
    $self->curr_dir($user_submitted_curr_dir);
  }
  else {
150
  # Go and grab the current directory and store it away
151 152 153 154 155
    my ( $package, $file, $line ) = caller;
    my $curr_dir = ( File::Spec->splitpath($file) )[1];
    if (!defined($curr_dir) || $curr_dir eq q{}) {
      $curr_dir = curdir();
    }
156 157 158
    else {
      $curr_dir = File::Spec->rel2abs($curr_dir);
    }
159
    $self->curr_dir($curr_dir);
160
  }
161
  $self->_rebless;
162

163
  if($ENV{'RUNTESTS_HARNESS'}) {
164 165
    my $target_file = catfile($self->curr_dir() , 'CLEAN.t');
    if (! -e $target_file) {
166 167
      my $clean_file = catfile( ( File::Spec->splitpath(__FILE__) )[1], 'CLEAN.pl' );
      copy($clean_file, $target_file ) or warning("# !! Could not copy $clean_file to $target_file\n");
168
    }
169
  }
170

171 172
  $species ||= DEFAULT_SPECIES;
  $self->species($species);
173

174 175 176 177
  if ( -e $self->get_frozen_config_file_path() ) {
      $self->load_config();
  }
  else {
178 179 180 181 182 183 184 185 186
    if(!$skip_database_loading) {
      # Load the databases and generate the conf hash
      $self->load_databases();
      # Freeze configuration in a file
      $self->store_config();
    }
    else {
      $self->{conf} = {};
    }
187
  }
188

189
  # Generate the db_adaptors from the $self->{'conf'} hash
190 191 192
  if(!$skip_database_loading) {
    $self->create_adaptors();
  }
193

194
  return $self;
195 196
}

197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213
#
# Rebless based on driver
#
sub _rebless {
    my ($self) = @_;
    my $driver = $self->db_conf->{driver};
    my $new_class = ref($self) . '::' . $driver;
    eval "require $new_class";
    if ($EVAL_ERROR) {
        $self->diag("Could not rebless to '$new_class': $EVAL_ERROR");
    } else {
        bless $self, $new_class;
        $self->note("Reblessed to '$new_class'");
    }
    return $self;
}

214
#
215
# Load configuration into $self->{'conf'} hash
216
#
217 218 219
sub load_config {
  my ($self) = @_;
  my $conf = $self->get_frozen_config_file_path();
220
  $self->{conf} = $self->_eval_file($conf);
221 222
  return;
}
223

224 225 226
#
# Build the target frozen config path 
#
227

228 229 230 231 232
sub get_frozen_config_file_path {
  my ($self) = @_;
  my $filename = sprintf('%s.%s', $self->species(), FROZEN_CONF_SUFFIX);
  my $conf = catfile($self->curr_dir(), $filename);
  return $conf;
233 234
}

235 236
sub _eval_file {
  my ($self, $file) = @_;
Andy Yates's avatar
Andy Yates committed
237 238 239
  if ( !-e $file ) {
    throw("Required configuration file '$file' does not exist");
  }
240 241 242 243 244 245
  my $contents = slurp($file);
  my $v = eval $contents;
  die "Could not read in configuration file '$file': $EVAL_ERROR" if $EVAL_ERROR;
  return $v;
}

246 247 248
#
# Store $self->{'conf'} hash into a file
#
249 250 251 252 253 254 255 256 257 258 259 260 261 262
sub store_config {
  my ($self) = @_;
  my $conf = $self->get_frozen_config_file_path();
  work_with_file($conf, 'w', sub {
    my ($fh) = @_;
    local $Data::Dumper::Indent    = 2;  # we want everything on one line
    local $Data::Dumper::Terse     = 1;  # and we want it without dummy variable names
    local $Data::Dumper::Sortkeys  = 1;  # make stringification more deterministic
    local $Data::Dumper::Quotekeys = 1;  # conserve some space
    local $Data::Dumper::Useqq     = 1;  # escape the \n and \t correctly
    print $fh Dumper($self->{conf});
    return;
  });
  return;
263
}
264

265 266 267 268
#
# Create a set of adaptors based on the $self->{'conf'} hash
#

269 270 271
sub create_adaptors {
  my ($self) = @_;
  foreach my $dbtype (keys %{$self->{conf}}) {
272 273 274 275 276 277 278 279 280 281
    $self->create_adaptor($dbtype);
  }
  return;
}

sub create_adaptor {
  my ($self, $dbtype) = @_;
  my $db = $self->{conf}->{$dbtype};
  my $module = $db->{module};
  if(eval "require $module") {
282
    my %args = map { ( "-${_}", $db->{$_} ) } qw(dbname user pass port host driver species group);
283
    if($dbtype eq 'hive') {
284 285
      $args{"-no_sql_schema_version_check"} = 1;
      $args{'-url'} = 'mysql://' . $args{'-user'} . ':' . $args{'-pass'} . '@' . $args{'-host'} . ':' . $args{'-port'} . '/' . $args{'-dbname'};
286
    }
287 288 289 290 291 292
    if($dbtype eq 'funcgen') {
      %args = (%args, map { ("-dnadb_${_}", $db->{${_}}) } qw/host user pass port/);
      # We wish to select the most recent core database generated by this user's test scripts.
      # This amounts to searching for the datase with the same prefix as the funcgen one, with the 
      # highest timestamp in suffix, i.e. the first element of the set of candidate name in reverse 
      # alphabetical order.
mag's avatar
mag committed
293 294 295 296 297 298
      my $mysql_out;
      if ($args{'-pass'}) {
        $mysql_out = `mysql -NB -u $args{'-user'} -p$args{'-pass'} -h $args{'-host'} -P $args{'-port'} -e 'show databases'`;
      } else {
        $mysql_out = `mysql -NB -u $args{'-user'} -h $args{'-host'} -P $args{'-port'} -e 'show databases'`;
      }
299 300 301 302 303 304 305 306 307 308
      my @databases = split(/^/, $mysql_out);
      my $dnadb_pattern = $args{'-dbname'};
      $dnadb_pattern =~ s/_funcgen_.*/_core_/;
      my @core_databases = grep /^$dnadb_pattern/, @databases;
      scalar(@core_databases) > 0 || die "Did not find any core database with pattern $dnadb_pattern:\n".join("\n", @databases);
      my @sorted_core_databases = sort {$b cmp $a} @core_databases;
      my $chosen_database = shift(@sorted_core_databases);
      chomp $chosen_database;
      $args{'-dnadb_name'} = $chosen_database; 
    }
309 310 311
    my $adaptor = eval{ $module->new(%args) };
    if($EVAL_ERROR) {
      $self->diag("!! Could not instantiate $dbtype DBAdaptor: $EVAL_ERROR");
312
    }
313 314
    else {
      $self->{db_adaptors}->{$dbtype} = $adaptor;
315
    }
316 317
  } else {
    die "Failed to load dependency on $module described in MultiTestDB.* files: $EVAL_ERROR";
318 319
  }
  return;
320
}
321

322 323 324
sub db_conf {
  my ($self) = @_;
  if(! $self->{db_conf}) {
325
    $self->{db_conf} = $self->get_db_conf($self->curr_dir());
326
  }
327 328
  return $self->{db_conf};
}
329

330 331 332
sub dbi_connection {
  my ($self) = @_;
  if(!$self->{dbi_connection}) {
333
    my $db = $self->_db_conf_to_dbi($self->db_conf(), $self->_dbi_options);
334 335 336 337 338 339 340 341
    if ( ! defined $db ) {
      $self->diag("!! Can't connect to database: ".$DBI::errstr);
      return;
    }
    $self->{dbi_connection} = $db;
  }
  return $self->{dbi_connection};
}
342

343 344 345
sub disconnect_dbi_connection {
  my ($self) = @_;
  if($self->{dbi_connection}) {
346
    $self->do_disconnect;
347
    delete $self->{dbi_connection};
348
  }
349 350
  return;
}
351

352 353 354
sub load_database {
  my ($self, $dbtype) = @_;
  my $db_conf = $self->db_conf();
355 356
  my $databases = $db_conf->{databases};
  my $preloaded = $db_conf->{preloaded} || {};
357 358
  my $species = $self->species();
  
359
  if(! $databases->{$species}) {
360
    die "Requested a database for species $species but the MultiTestDB.conf knows nothing about this";
361
  }
362 363 364 365
  
  my $config_hash = { %$db_conf };
  delete $config_hash->{databases};
  $config_hash->{module} = $databases->{$species}->{$dbtype};
366 367
  $config_hash->{species} = $species;
  $config_hash->{group} = $dbtype;
368 369
  $self->{conf}->{$dbtype} = $config_hash;
  my $dbname = $preloaded->{$species}->{$dbtype};
370 371
  my $driver_handle = $self->dbi_connection();
  if($dbname && $self->_db_exists($driver_handle, $dbname)) {
372 373 374 375 376
    $config_hash->{dbname} = $dbname;
    $config_hash->{preloaded} = 1;
  }
  else {
    if(! $dbname) {
377
      $dbname = $self->create_db_name($dbtype);
378 379 380 381 382
      delete $config_hash->{preloaded};
    }
    else {
      $config_hash->{preloaded} = 1;
    }
383

384 385
    $config_hash->{dbname} = $dbname;
    $self->note("Creating database $dbname");
386 387 388 389 390 391
    my %limits = ( 'mysql' => 64, 'pg' => 63 );
    if (my $l = $limits{lc $self->db_conf->{driver}}) {
        if (length($dbname) > $l) {
            die "Cannot create the database because its name is longer than the maximum the driver allows ($l characters)";
        }
    }
392
    my $db = $self->create_and_use_db($driver_handle, $dbname);
393

394 395
    my $base_dir = $self->base_dump_dir($self->curr_dir());
    my $dir_name = catdir( $base_dir, $species,  $dbtype );
396
    $self->load_sql($dir_name, $db, 'table.sql', 'sql');
397 398 399 400 401 402 403 404 405
    $self->load_txt_dumps($dir_name, $dbname, $db);
    $self->note("Loaded database '$dbname'");
  }
  return;
}

sub load_databases {
  my ($self) = shift; 
  my $species = $self->species();
406

407 408 409
  $self->note("Trying to load [$species] databases");  
  # Create a configuration hash which will be frozen to a file
  $self->{'conf'} = {};
410

411 412 413
  my @db_types = keys %{$self->db_conf()->{databases}->{$species}};
  foreach my $dbtype (@db_types) {
    $self->load_database($dbtype);
414
  }
415

416
  $self->disconnect_dbi_connection();
417
  return;
418 419
}

420 421 422
#
# Loads a DB from a single table.sql file or a set of *.sql files
#
423

424
sub load_sql {
425 426
  my ($self, $dir_name, $db, $override_name, $suffix, $override_must_exist) = @_;
  my @files = $self->driver_dump_files($dir_name, $suffix);
427

428 429
  my ($all_tables_sql) = grep { basename($_) eq $override_name } @files;
  return if $override_must_exist and not $all_tables_sql;
430 431 432 433 434 435

  my $sql_com = q{};
  if($all_tables_sql) {
    @files = ($all_tables_sql);
  }
  foreach my $sql_file (@files) {
Andy Yates's avatar
Andy Yates committed
436
    $self->note("Reading SQL from '$sql_file'");
437 438
    work_with_file($sql_file, 'r', sub {
      my ($fh) = @_;
439
      my $is_comment = 0;
440
      while(my $line = <$fh>) {
441 442 443 444 445 446 447 448 449 450 451 452 453 454 455

        if($is_comment == 1) {
          if($line =~ m/\*\//) {
            $is_comment = 0;
          }
          next;
        }

        if($line =~ m/\/\*/) {
          if($line !~ m/\*\//) {
            $is_comment = 1;
          }
          next;
        }

456 457 458 459 460
        #ignore comments and white-space lines
        if($line !~ /^#/ && $line =~ /\S/) {
          $sql_com .= $line;
        }
      }
461
      return;
462
    });
463

464
  }
465

466 467
  $sql_com =~ s/;$//;
  my @statements = split( /;/, $sql_com );
468
  $db->do("set foreign_key_checks = 0") if $self->db_conf->{driver} =~ /mysql/;
469
  foreach my $sql (@statements) {
470 471 472 473 474 475
    eval {
      $db->do($sql);
    };
    if($@) {
      throw "Could not execute SQL: $sql\n";
    }
476
  }
477
  $db->do("set foreign_key_checks = 1") if $self->db_conf->{driver} =~ /mysql/;
478

479
  return;
480 481
}

482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499
sub driver_dump_files {
  my ($self, $dir_name, $suffix) = @_;
  my $dir = IO::Dir->new($dir_name);
  if(! defined $dir) {
    $self->diag(" !! Could not open dump directory '$dir_name'");
    return;
  }
  my $driver_dir_name = catdir($dir_name, $self->db_conf->{driver});
  my $driver_dir = IO::Dir->new($driver_dir_name);
  if ($driver_dir) {
      $dir = $driver_dir;
      $dir_name = $driver_dir_name;
  }
  my @files = map { catfile($dir_name, $_) } grep { $_ =~ /\.${suffix}$/ } $dir->read();
  $dir->close();
  return (@files);
}

500 501 502 503 504 505 506 507
sub load_txt_dumps {
  my ($self, $dir_name, $dbname, $db) = @_;
  my $tables = $self->tables($db, $dbname);
  foreach my $tablename (@{$tables}) {
    my $txt_file = catfile($dir_name, $tablename.'.txt');
    if(! -f $txt_file || ! -r $txt_file) {
      next;
    }
508 509 510
    $self->do_pre_sql($dir_name, $tablename, $db);
    $db = $self->load_txt_dump($txt_file, $tablename, $db); # load_txt_dump may re-connect $db!
    $self->do_post_sql($dir_name, $tablename, $db);
511 512 513
  }
  return;
}
514

515 516 517 518 519 520 521 522 523 524 525 526
sub do_pre_sql {
  my ($self, $dir_name, $tablename, $db) = @_;
  $self->load_sql($dir_name, $db, "$tablename.pre", 'pre', 1);
  return;
}

sub do_post_sql {
  my ($self, $dir_name, $tablename, $db) = @_;
  $self->load_sql($dir_name, $db, "$tablename.post", 'post', 1);
  return;
}

527 528 529
sub tables {
  my ($self, $db, $dbname) = @_;
  my @tables;
530
  my $sth = $db->table_info(undef, $self->_schema_name($dbname), q{%}, 'TABLE');
531 532 533 534 535
  while(my $array = $sth->fetchrow_arrayref()) {
    push(@tables, $array->[2]);
  }
  return \@tables;
}
536

537 538 539 540 541 542
sub get_DBAdaptor {
  my ($self, $type, $die_if_not_found) = @_;
  die "No type specified" if ! $type;
  if(!$self->{db_adaptors}->{$type}) {
    $self->diag("!! Database adaptor of type $type is not available");
    if($die_if_not_found) {
543
      die "adaptor for $type is not available";
544 545 546 547
    }
    return;
  }
  return $self->{db_adaptors}->{$type};
548 549
}

550 551 552 553 554 555 556
sub add_DBAdaptor {
  my ($self, $type, $adaptor) = @_;
  die "No type specified" if ! $type;
  $self->{db_adaptors}->{$type} = $adaptor;
  return;
}

557 558 559
=head2 hide

  Arg [1]    : string $dbtype
560
               The type of the database containing the temporary table
561 562 563
  Arg [2]    : string $table
               The name of the table to hide
  Example    : $multi_test_db->hide('core', 'gene', 'transcript', 'exon');
564 565 566 567
  Description: Hides the contents of specific table(s) in the specified
               database.  The table(s) are first renamed and an empty
               table are created in their place by reading the table
               schema file.
568
  Returntype : none
569 570 571 572 573 574
  Exceptions : Thrown if the adaptor for dbtype is not available
               Thrown if both arguments are not defined
               Warning if there is already a temporary ("hidden")
               version of the table
               Warning if a temporary ("hidden") version of the table
               Cannot be created because its schema file cannot be read
575 576 577 578
  Caller     : general

=cut

579 580
sub hide {
  my ( $self, $dbtype, @tables ) = @_;
581

582 583
  die("dbtype and table args must be defined\n") if ! $dbtype || !@tables;
  my $adaptor = $self->get_DBAdaptor($dbtype, 1);
584

585 586 587 588
  foreach my $table (@tables) {
    if ( $self->{'conf'}->{$dbtype}->{'hidden'}->{$table} ) {
      $self->diag("!! Table '$table' is already hidden and cannot be hidden again");
      next;
589 590
    }

591 592
    my $hidden_name = "_hidden_$table";
    # Copy contents of table into a temporary table
593
    $adaptor->dbc->do("CREATE TABLE $hidden_name AS SELECT * FROM $table");
594 595 596 597
    # Delete the contents of the original table
    $adaptor->dbc->do("DELETE FROM $table");
    # Update the temporary table configuration
    $self->{'conf'}->{$dbtype}->{'hidden'}->{$table} = $hidden_name;
598

599
    $self->note("The table ${table} has been hidden in ${dbtype}");
600 601
  }
  return;
602
}
603 604 605 606

=head2 restore

  Arg [1]    : (optional) $dbtype 
607 608 609
               The dbtype of the table(s) to be restored. If not
               specified all hidden tables in all the databases are
               restored.
610
  Arg [2]    : (optional) @tables
611 612 613
               The name(s) of the table to be restored.  If not
               specified all hidden tables in the database $dbtype are
               restored.
614
  Example    : $self->restore('core', 'gene', 'transcript', 'exon');
615 616
  Description: Restores a list of hidden tables. The current version of
               the table is discarded and the hidden table is renamed.
617
  Returntype : none
618
  Exceptions : Thrown if the adaptor for a dbtype cannot be obtained
619 620 621 622
  Caller     : general

=cut

623 624
sub restore {
  my ( $self, $dbtype, @tables ) = @_;
625

626 627 628 629 630
  if ( !$dbtype ) {
    # Restore all of the tables in every dbtype
    foreach my $dbtype ( keys %{ $self->{'conf'} } ) {
        $self->restore($dbtype);
    }
631

632 633
    # Lose the hidden table details
    delete $self->{'conf'}->{'hidden'};
634

635 636
    return;
  }
637

638
  my $adaptor = $self->get_DBAdaptor($dbtype, 1);
639

640 641 642 643
  if ( !@tables ) {
    # Restore all of the tables for this database
    @tables = keys %{ $self->{'conf'}->{$dbtype}->{'hidden'} };
  }
644

645 646
  foreach my $table (@tables) {
    my $hidden_name = $self->{'conf'}->{$dbtype}->{'hidden'}->{$table};
647

648 649 650 651 652 653 654 655
    # Delete current contents of table
    $adaptor->dbc->do("DELETE FROM $table");
    # Copy contents of tmp table back into main table
    $adaptor->dbc->do("INSERT INTO $table SELECT * FROM $hidden_name");
    # Drop temp table
    $adaptor->dbc->do("DROP TABLE $hidden_name");
    # Delete value from hidden table configuration
    delete $self->{'conf'}->{$dbtype}->{'hidden'}->{$table};
656

657
    $self->note("The table ${table} has been restored in ${dbtype}");    
658 659
  }
  return;
660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682
}

=head2 save

  Arg [1]    : string $dbtype
               The type of the database containing the hidden/saved table
  Arg [2]    : string $table
               The name of the table to save
  Example    : $multi_test_db->save('core', 'gene', 'transcript', 'exon');
  Description: Saves the contents of specific table(s) in the specified db.
               The table(s) are first renamed and an empty table are created 
               in their place by reading the table schema file.  The contents
               of the renamed table(s) are then copied back into the newly
               created tables.  The method piggy-backs on the hide method
               and simply adds in the copying/insertion call.
  Returntype : none
  Exceptions : thrown if the adaptor for dbtype is not available
               warning if a table cannot be copied if the hidden table does not 
               exist
  Caller     : general

=cut

683 684
sub save {
  my ( $self, $dbtype, @tables ) = @_;
685

686 687
  # Use the hide method to build the basic tables
  $self->hide( $dbtype, @tables );
688

689
  my $adaptor = $self->get_DBAdaptor($dbtype, 1);
690

691
  foreach my $table (@tables) {
692
    my $hidden_name = '';
693 694 695 696 697
    # Only do if the hidden table exists
    if ( $self->{'conf'}->{$dbtype}->{'hidden'}->{$table} ) {
      $hidden_name = "_hidden_$table";
      # Copy the data from the hidden table into the new table
      $adaptor->dbc->do("insert into $table select * from $hidden_name");
698
      $self->note("The table ${table} contents has been saved in ${dbtype}");
699 700 701 702 703 704
    } 
    else {
      $self->diag("!! Hidden table '$hidden_name' does not exist so saving is not possible");
    }
  }
  return;
705 706
}

707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724
=head2 save_permanent

  Arg [1]    : string $dbtype
               The type of the database containing the hidden/saved table
  Arg [2-N]  : string $table
               The name of the table to save
  Example    : $multi_test_db->save_permanent('core', 'gene', 'transcript');
  Description: Saves the contents of specific table(s) in the specified db.
               The backup tables are not deleted by restore() or cleanup(), so
               this is mainly useful for debugging.
  Returntype : none
  Exceptions : thrown if the adaptor for dbtype is not available
               warning if a table cannot be copied if the hidden table does not 
               exist
  Caller     : general

=cut

725 726
sub save_permanent {
  my ( $self, $dbtype, @tables ) = @_;
727

728 729 730
  if ( !( $dbtype && @tables ) ) {
      die("dbtype and table args must be defined\n");
  }
731

732
  my $adaptor = $self->get_DBAdaptor($dbtype, 1);
733

734
  $self->{'conf'}->{$dbtype}->{'_counter'}++;
735

736 737
  foreach my $table (@tables) {
    my $hidden_name = "_bak_$table" . "_" . $self->{'conf'}->{$dbtype}->{'_counter'};
738
    $adaptor->dbc->do("CREATE TABLE $hidden_name AS SELECT * FROM $table");
739
    $self->note("The table ${table} has been permanently saved in ${dbtype}");
740 741
  }
  return;
742 743
}

744 745 746 747 748 749 750 751
sub _db_exists {
  my ( $self, $db, $db_name ) = @_;
  return 0 if ! $db_name;
  my $db_names = $db->selectall_arrayref('SHOW DATABASES');
  foreach my $db_name_ref (@{$db_names}) {
    return 1 if $db_name_ref->[0] eq $db_name;
  }
  return 0;
752 753
}

754 755 756 757
sub compare {
  my ( $self, $dbtype, $table ) = @_;
  $self->diag('!! Compare method not yet implemented');
  return;
758 759
}

760 761 762 763
sub species {
  my ( $self, $species ) = @_;
  $self->{species} = $species if $species;
  return $self->{species};
764 765
}

766 767 768 769
sub curr_dir {
  my ( $self, $cdir ) = @_;
  $self->{'_curr_dir'} = $cdir if $cdir;
  return $self->{'_curr_dir'};
770 771
}

772
sub create_db_name {
773
  my ( $self, $dbtype ) = @_;
774

775 776 777
  my @localtime = localtime();
  my $date      = strftime '%Y%m%d', @localtime;
  my $time      = strftime '%H%M%S', @localtime;
778

779
  my $species = $self->species();
780

781 782 783
  # Create a unique name using host and date / time info
  my $db_name = sprintf(
      '%s_test_db_%s_%s_%s_%s',
784 785 786 787 788
      (
        exists $ENV{'ENSEMBL_TESTDB_PREFIX'} ? $ENV{'ENSEMBL_TESTDB_PREFIX'}
          : exists $ENV{'LOGNAME'}           ? $ENV{'LOGNAME'}
          : $ENV{'USER'}
      ),
789 790
      $species, $dbtype, $date, $time
  );
791 792 793
  if (my $path = $self->_db_path($self->dbi_connection)) {
      $db_name = catfile($path, $db_name);
  }
794
  return $db_name;
795 796
}

797 798 799 800 801 802 803 804 805 806 807 808 809
sub cleanup {
  my ($self) = @_;

  # Remove all of the handles on db_adaptors
  %{$self->{db_adaptors}} = ();

  # Delete each of the created temporary databases
  foreach my $dbtype ( keys %{ $self->{conf} } ) {
    my $db_conf = $self->{conf}->{$dbtype};
    next if $db_conf->{preloaded};
    my $db = $self->_db_conf_to_dbi($db_conf);
    my $dbname  = $db_conf->{'dbname'};
    $self->note("Dropping database $dbname");
810
    $self->_drop_database($db, $dbname);
811 812 813 814 815 816 817 818 819
  }

  my $conf_file = $self->get_frozen_config_file_path();
  # Delete the frozen configuration file
  if ( -e $conf_file && -f $conf_file ) {
    $self->note("Deleting $conf_file");
    unlink $conf_file;
  }
  return;
820
}
821

822 823 824 825 826 827 828
sub DESTROY {
  my ($self) = @_;

  if ( $ENV{'RUNTESTS_HARNESS'} ) {
    # Restore tables, do nothing else we want to use the database
    # for the other tests as well
    $self->note('Leaving database intact on server');
829 830 831
    if(!$ENV{'RUNTESTS_HARNESS_NORESTORE'}) {
      $self->restore();
    }
832 833 834 835 836 837 838 839 840 841
  } else {
    # We are runnning a stand-alone test, cleanup created databases
    $self->note('Cleaning up...');

    # Restore database state since we may not actually delete it in
    # the cleanup - it may be defined as a preloaded database
    $self->restore();
    $self->cleanup();
  }
  return;
842 843 844
}

1;