use 5.008001;
our $VERSION = "0.05";
has ignore_tables => (
is => 'ro',
isa => 'ArrayRef',
default => sub { [] },
);
has _db => (
is => 'ro',
default => sub {
my $self = shift;
my $dsn0 = $self->dsn->[0];
my $db
= $dsn0 =~ /:mysql:/ ? 'MySQL'
: $dsn0 =~ /:Pg:/ ? 'PostgreSQL'
: do { my ($d) = $dsn0 =~ /dbi:(.*?):/; $d };
},
);
has _real_translator => (
is => 'ro',
lazy => 1,
default => sub {
my $self = shift;
my $translator = SQL::Translator->new(
parser => 'DBI',
parser_args => +{ dbh => $self->_dbh },
);
$translator->translate;
$translator->producer($self->_db);
if ($self->_db eq 'MySQL') {
my $schema = $translator->schema;
for my $table ($schema->get_tables) {
my @options = $table->options;
if (my ($idx) = grep { $options[$_]->{AUTO_INCREMENT} } 0..$#options) {
splice @{$table->options}, $idx, 1;
}
}
}
$translator;
},
);
no Mouse;
sub database_version {
my ($self, %args) = @_;
my $back = defined $args{back} ? $args{back} : 0;
croak sprintf 'invalid version_table: %s', $self->version_table
unless $self->version_table =~ /^[a-zA-Z_]+$/;
local $@;
my @versions = eval {
open my $fh, '>', \my $stderr;
local *STDERR = $fh;
$self->_dbh->selectrow_array('SELECT version FROM ' . $self->version_table . ' ORDER BY upgraded_at DESC');
};
return $versions[$back];
}
sub deploy {
my $self = shift;
if (@_) {
croak q[GitDDL::Migrator#deploy doesn't accepts any arguments]
}
if ($self->database_version) {
croak "database already deployed, use upgrade_database instead";
}
my $sql = $self->_slurp(File::Spec->catfile($self->work_tree, $self->ddl_file));
$self->_do_sql($sql);
$self->create_version_table($sql);
}
sub create_version_table {
my ($self, $sql) = @_;
$self->_do_sql(<<"__SQL__");
CREATE TABLE @{[ $self->version_table ]} (
version VARCHAR(40) NOT NULL,
upgraded_at VARCHAR(20) NOT NULL UNIQUE,
sql_text TEXT
);
__SQL__
$self->_insert_version(undef, $sql || '');
}
sub _new_translator {
my $self = shift;
my $translator = SQL::Translator->new;
$translator->parser($self->_db) or croak $translator->error;
$translator;
}
sub _new_translator_of_version {
my ($self, $version) = @_;
my $tmp_fh = File::Temp->new;
$self->_dump_sql_for_specified_commit($version, $tmp_fh->filename);
my $translator = $self->_new_translator;
$translator->translate($tmp_fh->filename) or croak $translator->error;
$translator;
}
sub _diff {
my ($self, $source, $target) = @_;
my $diff = SQL::Translator::Diff->new({
output_db => $self->_db,
source_schema => $source->schema,
target_schema => $target->schema,
})->compute_differences->produce_diff_sql;
$diff =~ s/.*?\n//;
$diff
}
sub diff {
my ($self, %args) = @_;
my $version = $args{version};
my $reverse = $args{reverse};
if (!$version && $self->check_version) {
return '';
}
my $source = $self->_new_translator_of_version($self->database_version);
my $target;
if (!$version) {
$target = $self->_new_translator;
$target->translate(File::Spec->catfile($self->work_tree, $self->ddl_file))
or croak $target->error;
}
else {
$target = $self->_new_translator_of_version($version);
}
my ($from, $to) = !$reverse ? ($source, $target) : ($target, $source);
$self->_diff($from, $to);
}
sub real_diff {
my $self = shift;
my $source = $self->_new_translator_of_version($self->database_version);
my $real = $self->_real_translator;
my $diff = SQL::Translator::Diff->new({
output_db => $self->_db,
source_schema => $source->schema,
target_schema => $real->schema,
})->compute_differences;
my @tabls_to_create = @{ $diff->tables_to_create };
@tabls_to_create = grep {sub {
my $table_name = shift;
return () if $table_name eq $self->version_table;
! grep { $table_name eq $_ } @{ $self->ignore_tables };
}->($_->name) } @tabls_to_create;
$diff->tables_to_create(\@tabls_to_create);
my $diff_str = $diff->produce_diff_sql;
$diff_str =~ s/.*?\n//;
$diff_str;
}
sub check_ddl_mismatch {
my $self = shift;
my $real_diff = $self->real_diff;
croak "Mismatch between ddl version and real database is found. Diff is:\n $real_diff"
unless $real_diff =~ /\A\s*-- No differences found;\s*\z/ms;
}
sub get_rollback_version {
my $self = shift;
my $sth = $self->_dbh->prepare('SELECT version FROM ' . $self->version_table . ' ORDER BY upgraded_at DESC');
$sth->execute;
my ($current_version) = $sth->fetchrow_array;
my ($prev_version) = $sth->fetchrow_array;
croak 'No rollback target is found' unless $prev_version;
$prev_version;
}
sub rollback_diff {
my $self = shift;
$self->diff(version => $self->get_rollback_version);
}
sub upgrade_database {
my ($self, %args) = @_;
croak 'Failed to get database version, please deploy first' unless $self->database_version;
my $version = $args{version};
my $sql = $args{sql} || $self->diff(version => $version);
return if $sql =~ /\A\s*\z/ms;
$self->_do_sql($sql);
$self->_insert_version($version, $sql);
}
sub migrate {
my $self = shift;
if (!$self->database_version) {
$self->deploy(@_);
}
else {
$self->upgrade_database(@_);
}
}
sub _insert_version {
my ($self, $version, $sql) = @_;
$version ||= $self->ddl_version;
unless (length($version) == 40) {
$version = $self->_restore_full_hash($version);
}
my @tm = gettimeofday();
my @dt = gmtime ($tm[0]);
my $upgraded_at = sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f",
$dt[5] + 1900,
$dt[4] + 1,
$dt[3],
$dt[2],
$dt[1],
$dt[0],
int($tm[1] / 1000),
);
$self->_dbh->do(
"INSERT INTO @{[ $self->version_table ]} (version, upgraded_at, sql_text) VALUES (?, ?, ?)", {}, $version, $upgraded_at, $sql
) or croak $self->_dbh->errstr;
}
sub _restore_full_hash {
my ($self, $version) = @_;
$self->_git->run('rev-parse', $version);
}
sub vacuum {
die 'to be implemented';
}
1;