is => 'ro',
default => sub { {} },
);
+
has script_directory => (
isa => 'Str',
is => 'ro',
default => 'sql',
);
+has _filesystem_interface => (
+ is => 'ro',
+ lazy_build => 1,
+ handles => {
+ _ddl_initialize_consume_filenames => '_ddl_initialize_consume_filenames',
+ _ddl_schema_consume_filenames => '_ddl_schema_consume_filenames',
+ _ddl_protoschema_deploy_consume_filenames => '_ddl_protoschema_deploy_consume_filenames',
+ _ddl_protoschema_upgrade_consume_filenames => '_ddl_protoschema_upgrade_consume_filenames',
+ _ddl_protoschema_downgrade_consume_filenames => '_ddl_protoschema_downgrade_consume_filenames',
+ _ddl_protoschema_produce_filename => '_ddl_protoschema_produce_filename',
+ _ddl_schema_produce_filename => '_ddl_schema_produce_filename',
+ _ddl_schema_upgrade_consume_filenames => '_ddl_schema_upgrade_consume_filenames',
+ _ddl_schema_downgrade_consume_filenames => '_ddl_schema_downgrade_consume_filenames',
+ _ddl_schema_upgrade_produce_filename => '_ddl_schema_upgrade_produce_filename',
+ _ddl_schema_downgrade_produce_filename => '_ddl_schema_downgrade_produce_filename',
+
+ _read_sql_file => '_read_sql_file',
+ _coderefs_per_files => '_coderefs_per_files',
+ _write_data_string => '_write_data_string',
+ _write_data_list => '_write_data_list',
+ },
+);
+
+sub _build__filesystem_interface {
+ use DBIx::Class::DeploymentHandler::Filesystem;
+ DBIx::Class::DeploymentHandler::Filesystem->new(
+ script_directory => $_[0]->script_directory,
+ ignore_ddl => $_[0]->ignore_ddl
+ )
+}
+
has databases => (
coerce => 1,
isa => 'DBIx::Class::DeploymentHandler::Databases',
# is built the same way, but we leave this in place
method _build_schema_version { $self->schema->schema_version }
-method __ddl_consume_with_prefix($type, $versions, $prefix) {
- my $base_dir = $self->script_directory;
-
- my $main = catfile( $base_dir, $type );
- my $common =
- catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
-
- my $common_any =
- catfile( $base_dir, '_common', $prefix, '_any' );
-
- my $dir;
- if (-d $main) {
- $dir = catfile($main, $prefix, join q(-), @{$versions})
- } else {
- if ($self->ignore_ddl) {
- return []
- } else {
- croak "$main does not exist; please write/generate some SQL"
- }
- }
- my $dir_any = catfile($main, $prefix, '_any');
-
- my %files;
- try {
- opendir my($dh), $dir;
- %files =
- map { $_ => "$dir/$_" }
- grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" }
- readdir $dh;
- closedir $dh;
- } catch {
- die $_ unless $self->ignore_ddl;
- };
- for my $dirname (grep { -d $_ } $common, $common_any, $dir_any) {
- opendir my($dh), $dirname;
- for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($dirname,$_) } readdir $dh) {
- unless ($files{$filename}) {
- $files{$filename} = catfile($dirname,$filename);
- }
- }
- closedir $dh;
- }
-
- return [@files{sort keys %files}]
-}
-
-method _ddl_initialize_consume_filenames($type, $version) {
- $self->__ddl_consume_with_prefix($type, [ $version ], 'initialize')
-}
-
-method _ddl_schema_consume_filenames($type, $version) {
- $self->__ddl_consume_with_prefix($type, [ $version ], 'deploy')
-}
-
-method _ddl_protoschema_deploy_consume_filenames($version) {
- my $base_dir = $self->script_directory;
-
- my $dir = catfile( $base_dir, '_source', 'deploy', $version);
- return [] unless -d $dir;
-
- opendir my($dh), $dir;
- my %files = map { $_ => "$dir/$_" } grep { /\.yml$/ && -f "$dir/$_" } readdir $dh;
- closedir $dh;
-
- return [@files{sort keys %files}]
-}
-
-method _ddl_protoschema_upgrade_consume_filenames($versions) {
- my $base_dir = $self->script_directory;
-
- my $dir = catfile( $base_dir, '_preprocess_schema', 'upgrade', join q(-), @{$versions});
-
- return [] unless -d $dir;
-
- opendir my($dh), $dir;
- my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
- closedir $dh;
-
- return [@files{sort keys %files}]
-}
-
-method _ddl_protoschema_downgrade_consume_filenames($versions) {
- my $base_dir = $self->script_directory;
-
- my $dir = catfile( $base_dir, '_preprocess_schema', 'downgrade', join q(-), @{$versions});
-
- return [] unless -d $dir;
-
- opendir my($dh), $dir;
- my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
- closedir $dh;
-
- return [@files{sort keys %files}]
-}
-
-method _ddl_protoschema_produce_filename($version) {
- my $dirname = catfile( $self->script_directory, '_source', 'deploy', $version );
- mkpath($dirname) unless -d $dirname;
-
- return catfile( $dirname, '001-auto.yml' );
-}
-
-method _ddl_schema_produce_filename($type, $version) {
- my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
- mkpath($dirname) unless -d $dirname;
-
- return catfile( $dirname, '001-auto.sql' );
-}
-
-method _ddl_schema_upgrade_consume_filenames($type, $versions) {
- $self->__ddl_consume_with_prefix($type, $versions, 'upgrade')
-}
-
-method _ddl_schema_downgrade_consume_filenames($type, $versions) {
- $self->__ddl_consume_with_prefix($type, $versions, 'downgrade')
-}
-
-method _ddl_schema_upgrade_produce_filename($type, $versions) {
- my $dir = $self->script_directory;
-
- my $dirname = catfile( $dir, $type, 'upgrade', join q(-), @{$versions});
- mkpath($dirname) unless -d $dirname;
-
- return catfile( $dirname, '001-auto.sql' );
-}
-
-method _ddl_schema_downgrade_produce_filename($type, $versions, $dir) {
- my $dirname = catfile( $dir, $type, 'downgrade', join q(-), @{$versions} );
- mkpath($dirname) unless -d $dirname;
-
- return catfile( $dirname, '001-auto.sql');
-}
-
method _run_sql_array($sql) {
my $storage = $self->storage;
die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
}
}
- open my $file, q(>), $filename;
- print {$file} join ";\n", @$sql;
- close $file;
+
+ $self->_write_data_list($filename, $sql);
}
}
);
}
-method _coderefs_per_files($files) {
- no warnings 'redefine';
- [map eval do { local( @ARGV, $/ ) = $_; <> }, @$files]
-}
-
method _prepare_changegrade($from_version, $to_version, $version_set, $direction) {
my $schema = $self->schema;
my $databases = $self->databases;
}
}
- open my $file, q(>), $diff_file;
- print {$file} join ";\n", @{$self->_sqldiff_from_yaml($from_version, $to_version, $db, $direction)};
- close $file;
+ $self->_write_data_list($diff_file,
+ $self->_sqldiff_from_yaml($from_version, $to_version, $db, $direction)
+ );
}
}
-method _read_sql_file($file) {
- return unless $file;
-
- open my $fh, '<', $file;
- my @data = split /;\n/, join '', <$fh>;
- close $fh;
-
- @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;
-
- return \@data;
-}
-
sub downgrade_single_step {
my $self = shift;
my $version_set = (shift @_)->{version_set};
}
}
- open my $file, q(>), $filename;
- print {$file} $yml;
- close $file;
+ $self->_write_data_string($filename, $yml);
}
__PACKAGE__->meta->make_immutable;
--- /dev/null
+package DBIx::Class::DeploymentHandler::Filesystem;
+
+use Moose;
+use Method::Signatures::Simple;
+use File::Path 'mkpath';
+use File::Spec::Functions;
+use Try::Tiny;
+
+has script_directory => (
+ isa => 'Str',
+ is => 'ro',
+ required => 1,
+ default => 'sql',
+);
+
+has ignore_ddl => ( is => 'ro' );
+
+
+method _ddl_protoschema_produce_filename($version) {
+ my $dirname = catfile( $self->script_directory, '_source', 'deploy', $version );
+ mkpath($dirname) unless -d $dirname;
+
+ return catfile( $dirname, '001-auto.yml' );
+}
+
+
+method _ddl_protoschema_deploy_consume_filenames($version) {
+ my $base_dir = $self->script_directory;
+
+ my $dir = catfile( $base_dir, '_source', 'deploy', $version);
+ return [] unless -d $dir;
+
+ opendir my($dh), $dir;
+ my %files = map { $_ => "$dir/$_" } grep { /\.yml$/ && -f "$dir/$_" } readdir $dh;
+ closedir $dh;
+
+ return [@files{sort keys %files}]
+}
+
+method _ddl_protoschema_upgrade_consume_filenames($versions) {
+ my $base_dir = $self->script_directory;
+
+ my $dir = catfile( $base_dir, '_preprocess_schema', 'upgrade', join q(-), @{$versions});
+
+ return [] unless -d $dir;
+
+ opendir my($dh), $dir;
+ my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
+ closedir $dh;
+
+ return [@files{sort keys %files}]
+}
+
+method _ddl_protoschema_downgrade_consume_filenames($versions) {
+ my $base_dir = $self->script_directory;
+
+ my $dir = catfile( $base_dir, '_preprocess_schema', 'downgrade', join q(-), @{$versions});
+
+ return [] unless -d $dir;
+
+ opendir my($dh), $dir;
+ my %files = map { $_ => "$dir/$_" } grep { /\.pl$/ && -f "$dir/$_" } readdir $dh;
+ closedir $dh;
+
+ return [@files{sort keys %files}]
+}
+
+
+
+method __ddl_consume_with_prefix($type, $versions, $prefix) {
+ my $base_dir = $self->script_directory;
+
+ my $main = catfile( $base_dir, $type );
+ my $common =
+ catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
+
+ my $common_any =
+ catfile( $base_dir, '_common', $prefix, '_any' );
+
+ my $dir;
+ if (-d $main) {
+ $dir = catfile($main, $prefix, join q(-), @{$versions})
+ } else {
+ if ($self->ignore_ddl) {
+ return []
+ } else {
+ die "$main does not exist; please write/generate some SQL"
+ }
+ }
+ my $dir_any = catfile($main, $prefix, '_any');
+
+ my %files;
+ try {
+ opendir my($dh), $dir;
+ %files =
+ map { $_ => "$dir/$_" }
+ grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" }
+ readdir $dh;
+ closedir $dh;
+ } catch {
+ die $_ unless $self->ignore_ddl;
+ };
+ for my $dirname (grep { -d $_ } $common, $common_any, $dir_any) {
+ opendir my($dh), $dirname;
+ for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($dirname,$_) } readdir $dh) {
+ unless ($files{$filename}) {
+ $files{$filename} = catfile($dirname,$filename);
+ }
+ }
+ closedir $dh;
+ }
+
+ return [@files{sort keys %files}]
+}
+
+method _ddl_initialize_consume_filenames($type, $version) {
+ $self->__ddl_consume_with_prefix($type, [ $version ], 'initialize')
+}
+
+method _ddl_schema_consume_filenames($type, $version) {
+ $self->__ddl_consume_with_prefix($type, [ $version ], 'deploy')
+}
+
+method _ddl_schema_upgrade_consume_filenames($type, $versions) {
+ $self->__ddl_consume_with_prefix($type, $versions, 'upgrade')
+}
+
+method _ddl_schema_downgrade_consume_filenames($type, $versions) {
+ $self->__ddl_consume_with_prefix($type, $versions, 'downgrade')
+}
+
+
+method _ddl_schema_produce_filename($type, $version) {
+ my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
+ mkpath($dirname) unless -d $dirname;
+
+ return catfile( $dirname, '001-auto.sql' );
+}
+
+method _ddl_schema_upgrade_produce_filename($type, $versions) {
+ my $dir = $self->script_directory;
+
+ my $dirname = catfile( $dir, $type, 'upgrade', join q(-), @{$versions});
+ mkpath($dirname) unless -d $dirname;
+
+ return catfile( $dirname, '001-auto.sql' );
+}
+
+method _ddl_schema_downgrade_produce_filename($type, $versions, $dir) {
+ my $dirname = catfile( $dir, $type, 'downgrade', join q(-), @{$versions} );
+ mkpath($dirname) unless -d $dirname;
+
+ return catfile( $dirname, '001-auto.sql');
+}
+
+
+method _read_sql_file($file) {
+ return unless $file;
+
+ open my $fh, '<', $file;
+ my @data = split /;\n/, join '', <$fh>;
+ close $fh;
+
+ @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;
+
+ return \@data;
+}
+
+method _coderefs_per_files($files) {
+ no warnings 'redefine';
+ [map eval do { local( @ARGV, $/ ) = $_; <> }, @$files]
+}
+
+
+method _write_data_string($filename, $data) {
+ open my $file, q(>), $filename;
+ print {$file} $data;
+ close $file;
+}
+
+
+method _write_data_list($filename, $data) {
+ open my $file, q(>), $filename;
+ print {$file} join ";\n", @$data;
+ close $file;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Deep;
+
+use lib 't/lib';
+use aliased 'DBIx::Class::DeploymentHandler::Filesystem';
+
+my $fs = Filesystem->new({ script_directory => 't/filesystem' });
+
+my @t = (
+ (map +{ meth => '_ddl_schema_consume_filenames', %$_ },
+ {
+ args => ['MySQL', 1],
+ expected => ['t/filesystem/MySQL/deploy/1/001-auto.sql'],
+ },
+ {
+ args => ['MySQL', 2],
+ expected => ['t/filesystem/MySQL/deploy/2/001-auto.sql'],
+ },
+ {
+ args => ['MySQL', 3],
+ expected => ['t/filesystem/MySQL/deploy/3/001-auto.sql'],
+ },
+ {
+ args => ['SQLite', 1],
+ expected => ['t/filesystem/SQLite/deploy/1/001-auto.sql'],
+ },
+ {
+ args => ['SQLite', 2],
+ expected => ['t/filesystem/SQLite/deploy/2/001-auto.sql'],
+ },
+ {
+ args => ['SQLite', 3],
+ expected => ['t/filesystem/SQLite/deploy/3/001-auto.sql'],
+ }),
+
+ (map +{ meth => '_ddl_schema_produce_filename', %$_ },
+ {
+ args => ['MySQL', 1],
+ expected => 't/filesystem/MySQL/deploy/1/001-auto.sql',
+ },
+ {
+ args => ['MySQL', 2],
+ expected => 't/filesystem/MySQL/deploy/2/001-auto.sql',
+ },
+ {
+ args => ['MySQL', 3],
+ expected => 't/filesystem/MySQL/deploy/3/001-auto.sql',
+ },
+ {
+ args => ['SQLite', 1],
+ expected => 't/filesystem/SQLite/deploy/1/001-auto.sql',
+ },
+ {
+ args => ['SQLite', 2],
+ expected => 't/filesystem/SQLite/deploy/2/001-auto.sql',
+ },
+ {
+ args => ['SQLite', 3],
+ expected => 't/filesystem/SQLite/deploy/3/001-auto.sql',
+ }),
+
+ ( map +{ meth => '_ddl_initialize_consume_filenames', %$_ },
+ {
+ args => ['MySQL', 1],
+ expected => [
+ 't/filesystem/MySQL/initialize/1/001-create-database.pl',
+ 't/filesystem/MySQL/initialize/1/002-create-users.pl'
+ ],
+ }, {
+ args => ['MySQL', 2],
+ expected => [
+ 't/filesystem/MySQL/initialize/2/001-create-database.pl',
+ 't/filesystem/MySQL/initialize/2/002-create-users.pl'
+ ],
+ }, {
+ args => ['MySQL', 3],
+ expected => [
+ 't/filesystem/MySQL/initialize/3/001-create-database.pl',
+ 't/filesystem/MySQL/initialize/3/002-create-users.pl'
+ ],
+ }, {
+ args => ['SQLite', 1],
+ expected => [
+ 't/filesystem/SQLite/initialize/1/001-create-database.pl',
+ 't/filesystem/SQLite/initialize/1/002-create-users.pl'
+ ],
+ }, {
+ args => ['SQLite', 2],
+ expected => [
+ 't/filesystem/SQLite/initialize/2/001-create-database.pl',
+ 't/filesystem/SQLite/initialize/2/002-create-users.pl'
+ ],
+ }, {
+ args => ['SQLite', 3],
+ expected => [
+ 't/filesystem/SQLite/initialize/3/001-create-database.pl',
+ 't/filesystem/SQLite/initialize/3/002-create-users.pl'
+ ],
+ }),
+
+ ( map +{ meth => '_ddl_protoschema_deploy_consume_filenames', %$_ },
+ {
+ args => [1],
+ expected => ['t/filesystem/_source/deploy/1/001-auto.yml'],
+ }, {
+ args => [2],
+ expected => ['t/filesystem/_source/deploy/2/001-auto.yml'],
+ }, {
+ args => [3],
+ expected => ['t/filesystem/_source/deploy/3/001-auto.yml'],
+ }),
+
+ ( map +{ meth => '_ddl_protoschema_upgrade_consume_filenames', %$_ },
+ {
+ args => [[1,2]],
+ expected => ['t/filesystem/_preprocess_schema/upgrade/1-2/001-rename-columns.pl'],
+ }, {
+ args => [[2,3]],
+ expected => ['t/filesystem/_preprocess_schema/upgrade/2-3/001-rename-columns.pl'],
+ }),
+
+ ( map +{ meth => '_ddl_protoschema_downgrade_consume_filenames', %$_ },
+ {
+ args => [[2,1]],
+ expected => ['t/filesystem/_preprocess_schema/downgrade/2-1/001-rename-columns.pl'],
+ }, {
+ args => [[3,2]],
+ expected => ['t/filesystem/_preprocess_schema/downgrade/3-2/001-rename-columns.pl'],
+ }),
+
+ ( map +{ meth => '_ddl_protoschema_produce_filename', %$_ },
+ {
+ args => [1],
+ expected => 't/filesystem/_source/deploy/1/001-auto.yml',
+ }, {
+ args => [2],
+ expected => 't/filesystem/_source/deploy/2/001-auto.yml',
+ }, {
+ args => [3],
+ expected => 't/filesystem/_source/deploy/3/001-auto.yml',
+ }),
+
+ ( map +{ meth => '_ddl_schema_upgrade_consume_filenames', %$_ },
+ {
+ args => ['MySQL', [1,2]],
+ expected => ['t/filesystem/MySQL/upgrade/1-2/001-auto.sql'],
+ },
+ {
+ args => ['MySQL', [2,3]],
+ expected => ['t/filesystem/MySQL/upgrade/2-3/001-auto.sql'],
+ },
+ {
+ args => ['SQLite', [1,2]],
+ expected => ['t/filesystem/SQLite/upgrade/1-2/001-auto.sql'],
+ },
+ {
+ args => ['SQLite', [2,3]],
+ expected => ['t/filesystem/SQLite/upgrade/2-3/001-auto.sql'],
+ }),
+
+ ( map +{ meth => '_ddl_schema_downgrade_consume_filenames', %$_ },
+ {
+ args => ['MySQL', [2,1]],
+ expected => ['t/filesystem/MySQL/downgrade/2-1/001-auto.sql'],
+ },
+ {
+ args => ['MySQL', [3,2]],
+ expected => ['t/filesystem/MySQL/downgrade/3-2/001-auto.sql'],
+ },
+ {
+ args => ['SQLite', [2,1]],
+ expected => ['t/filesystem/SQLite/downgrade/2-1/001-auto.sql'],
+ },
+ {
+ args => ['SQLite', [3,2]],
+ expected => ['t/filesystem/SQLite/downgrade/3-2/001-auto.sql'],
+ }),
+);
+
+for (@t) {
+ my $m = $_->{meth};
+ cmp_deeply
+ $fs->$m(@{$_->{args}}),
+ $_->{expected},
+ "$m(" . join (', ', map { ref $_ ? '[' . join(', ', @$_) . ']' : $_ } @{$_->{args}}) . ')';
+}
+
+done_testing;
projects / dbsrgits/DBIx-Class-DeploymentHandler.git / commitdiff