copy-schema.pl

#!perl
use strict;
use warnings;

use DBI;

sub copy_schema_from_test_db ($$$$) {
    my ($orig_dsn, $user, $password, $new_dbh) = @_;

    my $old_dbh = DBI->connect($orig_dsn, $user, $password)
        or BAIL_OUT($DBI::errstr);

    my $sth_tables = $old_dbh->prepare('SHOW TABLES');
    $sth_tables->execute;
    while (my $row_table = $sth_tables->fetch) {
        my $table = $old_dbh->quote_identifier($row_table->[0]);
        my $sth_create = $old_dbh->prepare("SHOW CREATE TABLE $table");
        $sth_create->execute;
        my $create_statement = $sth_create->fetch->[1];
        $new_dbh->do($create_statement) or die $new_dbh->errstr;
    }
}