#!/usr/bin/perl
use lib qw(t/lib);
use strict;
use warnings;
use Test::OnlineDDL;
############################################################
my $CHUNK_SIZE = $CDTEST_MASS_POPULATE ? 5000 : 3;
my $dbms_name = CDTest->dbms_name;
############################################################
my $blank_schema = CDTest->init_schema( no_connect => 1 );
my @source_names =
grep { !$blank_schema->source($_)->isa('DBIx::Class::ResultSource::View') } # no views
$blank_schema->sources
;
foreach my $source_name (sort @source_names) {
my %copy_opts = (
chunk_size => $CHUNK_SIZE,
);
# Avoid warnings for multi-column PKs by adding the first column ourselves
if ($source_name =~ /\wTo[A-Z]/) {
$copy_opts{id_name} = ($blank_schema->source($source_name)->primary_columns)[0];
}
onlineddl_test 'No-op', $source_name, sub {
my $cd_schema = shift;
my $rsrc = $cd_schema->source($source_name);
my $table_name = $rsrc->name;
# Constructor
my $online_ddl = DBIx::OnlineDDL->new(
rsrc => $rsrc,
# purposely not adding any (useful) coderef_hooks
coderef_hooks => { before_triggers => sub {} },
copy_opts => \%copy_opts,
);
is $online_ddl->table_name, $table_name, 'Figured out table_name';
is $online_ddl->new_table_name, "_${table_name}_new", 'Figured out new_table_name';
my $helper = $online_ddl->_helper;
my $orig_table_sql = $helper->create_table_sql($table_name);
try_ok { $online_ddl->execute } 'Execute works';
my $new_table_sql = $helper->create_table_sql($table_name);
# Remove AUTO_INCREMENT information
$orig_table_sql =~ s/ AUTO_INCREMENT=\K\d+/###/;
$new_table_sql =~ s/ AUTO_INCREMENT=\K\d+/###/;
is $new_table_sql, $orig_table_sql, "New table SQL for `$table_name` matches the old one" or do {
diag "NEW: $new_table_sql";
diag "OLD: $orig_table_sql";
};
# Verify post-connection variables are still active even after some disconnections. It
# seems to be rather hard to query certain SQLite PRAGMA settings, however, so we'll skip
# the checks for SQLite.
my $dbh = $cd_schema->storage->dbh;
if ($dbms_name eq 'MySQL') {
my $db_timeouts = $online_ddl->db_timeouts;
my $session_vals = $dbh->selectrow_hashref(
'SELECT @@foreign_key_checks AS fk_checks, @@wait_timeout AS timeout_session, '.
'@@lock_wait_timeout AS timeout_lock_db, @@innodb_lock_wait_timeout AS timeout_lock_row'
);
is $session_vals, {
fk_checks => 0,
map {; "timeout_$_" => $db_timeouts->{$_} } qw< session lock_db lock_row >
}, "Session values looks right";
}
};
onlineddl_test 'Add column', $source_name, sub {
my $cd_schema = shift;
my $rsrc = $cd_schema->source($source_name);
my $table_name = $rsrc->name;
# Constructor
my $online_ddl = DBIx::OnlineDDL->new(
rsrc => $rsrc,
coderef_hooks => {
before_triggers => sub {
my $oddl = shift;
my $dbh = $oddl->dbh;
my $name = $oddl->new_table_name;
my $qname = $dbh->quote_identifier($name);
my $qcol = $dbh->quote_identifier('test_column');
$oddl->dbh_runner_do("ALTER TABLE $qname ADD COLUMN $qcol VARCHAR(100) NULL");
},
},
copy_opts => \%copy_opts,
);
try_ok { $online_ddl->execute } 'Execute works';
# Verify the column exists
my $dbh = $cd_schema->storage->dbh;
my $vars = $online_ddl->_vars;
my $catalog = $vars->{catalog};
my $schema = $vars->{schema};
my %cols = %{ $dbh->column_info( $catalog, $schema, $table_name, '%' )->fetchall_hashref('COLUMN_NAME') };
like(
$cols{test_column},
{
TABLE_CAT => $catalog,
TABLE_SCHEM => $schema,
TABLE_NAME => $table_name,
COLUMN_NAME => 'test_column',
COLUMN_SIZE => 100,
TYPE_NAME => 'VARCHAR',
IS_NULLABLE => 'YES',
NULLABLE => 1,
ORDINAL_POSITION => (scalar $rsrc->columns + 1),
},
'New column exists in table',
);
};
}
############################################################
done_testing;