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;