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;
projects / dbsrgits/DBIx-Class-DeploymentHandler.git / blobdiff