use autodie;
use Carp qw( carp croak );
-use Log::Contextual::WarnLogger;
-use Log::Contextual qw(:log :dlog), -default_logger => Log::Contextual::WarnLogger->new({
- env_prefix => 'DBICDH'
-});
-use Data::Dumper::Concise;
+use DBIx::Class::DeploymentHandler::Logger;
+use Log::Contextual qw(:log :dlog), -default_logger =>
+ DBIx::Class::DeploymentHandler::Logger->new({
+ env_prefix => 'DBICDH'
+ });
use Method::Signatures::Simple;
use Try::Tiny;
# is built the same way, but we leave this in place
method _build_schema_version { $self->schema->schema_version }
-has _json => (
- is => 'ro',
- lazy_build => 1,
-);
-
-sub _build__json { require JSON; JSON->new->pretty }
-
method __ddl_consume_with_prefix($type, $versions, $prefix) {
my $base_dir = $self->script_directory;
my $dirname = catfile( $self->script_directory, $type, 'schema', $version );
mkpath($dirname) unless -d $dirname;
- return catfile( $dirname, '001-auto.sql-json' );
+ return catfile( $dirname, '001-auto.sql' );
}
method _ddl_schema_up_consume_filenames($type, $versions) {
my $dirname = catfile( $dir, $type, 'up', join q(-), @{$versions});
mkpath($dirname) unless -d $dirname;
- return catfile( $dirname, '001-auto.sql-json' );
+ return catfile( $dirname, '001-auto.sql'
+ );
}
method _ddl_schema_down_produce_filename($type, $versions, $dir) {
my $dirname = catfile( $dir, $type, 'down', join q(-), @{$versions} );
mkpath($dirname) unless -d $dirname;
- return catfile( $dirname, '001-auto.sql-json');
+ return catfile( $dirname, '001-auto.sql');
}
method _run_sql_array($sql) {
join '', grep { !/^--/ } split /\n/ # remove comments
} @$sql];
- log_trace { '[DBICDH] Running SQL ' . Dumper($sql) };
+ Dlog_trace { "Running SQL $_" } $sql;
foreach my $line (@{$sql}) {
$storage->_query_start($line);
# the whole reason we do this is so that we can see the line that was run
}
method _run_sql($filename) {
- log_debug { "[DBICDH] Running SQL from $filename" };
+ log_debug { "Running SQL from $filename" };
return $self->_run_sql_array($self->_read_sql_file($filename));
}
method _run_perl($filename) {
- log_debug { "[DBICDH] Running Perl from $filename" };
+ log_debug { "Running Perl from $filename" };
my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
no warnings 'redefine';
my $fn = eval "$filedata";
use warnings;
- log_trace { '[DBICDH] Running Perl ' . Dumper($fn) };
+ Dlog_trace { "Running Perl $_" } $fn;
if ($@) {
carp "$filename failed to compile: $@";
carp "$filename should define an anonymouse sub that takes a schema but it didn't!";
}
}
+{
+ my $json;
+
+ method _run_serialized_sql($filename, $type) {
+ if ($type eq 'json') {
+ require JSON;
+ $json ||= JSON->new->pretty;
+ my @sql = @{$json->decode($filename)};
+ } else {
+ croak "A file ($filename) got to deploy that wasn't sql or perl!";
+ }
+ }
-method _run_serialized_sql($filename, $type) {
- if (lc $type eq 'json') {
- return $self->_run_sql_array($self->_json->decode(
- do { local( @ARGV, $/ ) = $filename; <> } # slurp
- ))
- } else {
- croak "$type is not one of the supported serialzed types"
- }
}
method _run_sql_and_perl($filenames) {
sub deploy {
my $self = shift;
my $version = (shift @_ || {})->{version} || $self->schema_version;
- log_info { "[DBICDH] deploying version $version" };
+ log_info { "deploying version $version" };
return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
$self->storage->sqlt_type,
my $self = shift;
my $args = shift;
my $version = $args->{version} || $self->schema_version;
- log_info { "[DBICDH] preinstalling version $version" };
+ log_info { "preinstalling version $version" };
my $storage_type = $args->{storage_type} || $self->storage->sqlt_type;
my @files = @{$self->_ddl_preinstall_consume_filenames(
my $version = $self->schema_version;
my $sqlt = SQL::Translator->new({
- no_comments => 1,
add_drop_table => 1,
ignore_constraint_names => 1,
ignore_index_names => 1,
unlink $filename;
}
- my $sql = $self->_generate_final_sql($sqlt);
- if(!$sql) {
+ my $output = $sqlt->translate;
+ if(!$output) {
carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
next;
}
open my $file, q(>), $filename;
- print {$file} $sql;
+ print {$file} $output;
close $file;
}
}
-method _generate_final_sql($sqlt) {
- my @output = $sqlt->translate;
- $self->_json->encode(\@output);
-}
-
sub _resultsource_install_filename {
my ($self, $source_name) = @_;
return sub {
my $dirname = catfile( $self->script_directory, $type, 'schema', $version );
mkpath($dirname) unless -d $dirname;
- return catfile( $dirname, "001-auto-$source_name.sql-json" );
+ return catfile( $dirname, "001-auto-$source_name.sql" );
}
}
my ($self, $args) = @_;
my $source = $args->{result_source};
my $version = $args->{version};
- log_info { '[DBICDH] installing_resultsource ' . $source->source_name . ", version $version" };
+ log_info { 'installing_resultsource ' . $source->source_name . ", version $version" };
my $rs_install_file =
$self->_resultsource_install_filename($source->source_name);
sub prepare_resultsource_install {
my $self = shift;
my $source = (shift @_)->{result_source};
- log_info { '[DBICDH] preparing install for resultsource ' . $source->source_name };
+ log_info { 'preparing install for resultsource ' . $source->source_name };
my $filename = $self->_resultsource_install_filename($source->source_name);
$self->_prepare_install({
}
sub prepare_deploy {
- log_info { '[DBICDH] preparing deploy' };
+ log_info { 'preparing deploy' };
my $self = shift;
$self->_prepare_install({}, '_ddl_schema_produce_filename');
}
sub prepare_upgrade {
my ($self, $args) = @_;
log_info {
- '[DBICDH] preparing upgrade ' .
- "from $args->{from_version} to $args->{to_version}"
+ "preparing upgrade from $args->{from_version} to $args->{to_version}"
};
$self->_prepare_changegrade(
$args->{from_version}, $args->{to_version}, $args->{version_set}, 'up'
sub prepare_downgrade {
my ($self, $args) = @_;
log_info {
- '[DBICDH] preparing downgrade ' .
- "from $args->{from_version} to $args->{to_version}"
+ "preparing downgrade from $args->{from_version} to $args->{to_version}"
};
$self->_prepare_changegrade(
$args->{from_version}, $args->{to_version}, $args->{version_set}, 'down'
$sqltargs = {
add_drop_table => 1,
- no_comments => 1,
ignore_constraint_names => 1,
ignore_index_names => 1,
%{$sqltargs}
$t->parser( $db ) # could this really throw an exception?
or croak($t->error);
- my $sql = $self->_default_read_sql_file_as_string($prefilename);
- my $out = $t->translate( \$sql )
+ my $out = $t->translate( $prefilename )
or croak($t->error);
$source_schema = $t->schema;
or croak($t->error);
my $filename = $self->_ddl_schema_produce_filename($db, $to_version, $dir);
- my $sql = $self->_default_read_sql_file_as_string($filename);
- my $out = $t->translate( \$sql )
+ my $out = $t->translate( $filename )
or croak($t->error);
$dest_schema = $t->schema;
unless $dest_schema->name;
}
+ my $diff = SQL::Translator::Diff::schema_diff(
+ $source_schema, $db,
+ $dest_schema, $db,
+ $sqltargs
+ );
open my $file, q(>), $diff_file;
- print {$file}
- $self->_generate_final_diff($source_schema, $dest_schema, $db, $sqltargs);
+ print {$file} $diff;
close $file;
}
}
-method _generate_final_diff($source_schema, $dest_schema, $db, $sqltargs) {
- $self->_json->encode([
- SQL::Translator::Diff::schema_diff(
- $source_schema, $db,
- $dest_schema, $db,
- $sqltargs
- )
- ])
-}
-
method _read_sql_file($file) {
return unless $file;
my @data = split /;\n/, join '', <$fh>;
close $fh;
- return \@data;
-}
+ @data = grep {
+ $_ && # remove blank lines
+ !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's
+ } map {
+ s/^\s+//; s/\s+$//; # trim whitespace
+ join '', grep { !/^--/ } split /\n/ # remove comments
+ } @data;
-method _default_read_sql_file_as_string($file) {
- return join q(), map "$_;\n", @{$self->_json->decode(
- do { local( @ARGV, $/ ) = $file; <> } # slurp
- )};
+ return \@data;
}
sub downgrade_single_step {
my $self = shift;
my $version_set = (shift @_)->{version_set};
- log_info { qq([DBICDH] downgrade_single_step'ing ) . Dumper($version_set) };
+ Dlog_info { "downgrade_single_step'ing $_" } $version_set;
my $sql = $self->_run_sql_and_perl($self->_ddl_schema_down_consume_filenames(
$self->storage->sqlt_type,
sub upgrade_single_step {
my $self = shift;
my $version_set = (shift @_)->{version_set};
- log_info { qq([DBICDH] upgrade_single_step'ing ) . Dumper($version_set) };
+ Dlog_info { "upgrade_single_step'ing $_" } $version_set;
my $sql = $self->_run_sql_and_perl($self->_ddl_schema_up_consume_filenames(
$self->storage->sqlt_type,
projects / dbsrgits/DBIx-Class-DeploymentHandler.git / blobdiff