my $base_dir = $self->script_directory;
my $main = catfile( $base_dir, $type );
- my $generic = catfile( $base_dir, '_generic' );
my $common =
catfile( $base_dir, '_common', $prefix, join q(-), @{$versions} );
my $dir;
if (-d $main) {
$dir = catfile($main, $prefix, join q(-), @{$versions})
- } elsif (-d $generic) {
- $dir = catfile($generic, $prefix, join q(-), @{$versions});
} else {
- croak "neither $main or $generic exist; please write/generate some SQL";
+ croak "$main does not exist; please write/generate some SQL";
}
- opendir my($dh), $dir;
- my %files = map { $_ => "$dir/$_" } grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" } readdir $dh;
- closedir $dh;
-
+ 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;
+ };
if (-d $common) {
opendir my($dh), $common;
for my $filename (grep { /\.(?:sql|pl)$/ && -f catfile($common,$_) } readdir $dh) {
$self->__ddl_consume_with_prefix($type, [ $version ], 'schema')
}
+method _ddl_protoschema_up_consume_filenames($versions) {
+ my $base_dir = $self->script_directory;
+
+ my $dir = catfile( $base_dir, '_protoschema', 'up', 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_down_consume_filenames($versions) {
+ my $base_dir = $self->script_directory;
+
+ my $dir = catfile( $base_dir, '_protoschema', 'down', 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, '_protoschema', $version );
+ my $dirname = catfile( $self->script_directory, '_protoschema', 'schema', $version );
mkpath($dirname) unless -d $dirname;
return catfile( $dirname, '001-auto.yml' );
}
}
-method _run_sql_and_perl($filenames) {
+method _run_sql_and_perl($filenames, $sql_to_run) {
my @files = @{$filenames};
my $guard = $self->schema->txn_scope_guard if $self->txn_wrap;
- my $sql = '';
+ $self->_run_sql_array($sql_to_run) if $self->ignore_ddl;
+
+ my $sql = ($sql_to_run)?join ";\n", @$sql_to_run:'';
+ FILENAME:
for my $filename (@files) {
- if ($filename =~ /\.sql$/) {
+ if ($self->ignore_ddl && $filename =~ /^[^_]*-auto.*\.sql$/) {
+ next FILENAME
+ } elsif ($filename =~ /\.sql$/) {
$sql .= $self->_run_sql($filename)
} elsif ( $filename =~ /\.pl$/ ) {
$self->_run_perl($filename)
return $sql;
}
-method _deploy($version) {
- return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
- $self->storage->sqlt_type,
- $version,
- ));
-}
-
sub deploy {
my $self = shift;
my $version = (shift @_ || {})->{version} || $self->schema_version;
log_info { "deploying version $version" };
- $self->_deploy($version);
+ my $sqlt_type = $self->storage->sqlt_type;
+ my $sql;
+ if ($self->ignore_ddl) {
+ $sql = $self->_sql_from_yaml({},
+ '_ddl_protoschema_produce_filename', $sqlt_type
+ );
+ }
+ return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
+ $sqlt_type,
+ $version,
+ ), $sql);
}
sub preinstall {
}
}
-method _sqldiff_from_yaml($from_version, $to_version, $db) {
+method _sqldiff_from_yaml($from_version, $to_version, $db, $direction) {
my $dir = $self->script_directory;
my $sqltargs = {
add_drop_table => 1,
$dest_schema->name( $filename )
unless $dest_schema->name;
}
+
+ my $transform_files_method = "_ddl_protoschema_${direction}_consume_filenames";
+ my $transforms = $self->_coderefs_per_files(
+ $self->$transform_files_method([$from_version, $to_version])
+ );
+ $_->($source_schema, $dest_schema) for @$transforms;
+
return [SQL::Translator::Diff::schema_diff(
$source_schema, $db,
$dest_schema, $db,
my $version = $self->schema_version;
my $sqlt = SQL::Translator->new({
- add_drop_table => 1,
+ add_drop_table => 0,
parser => 'SQL::Translator::Parser::YAML',
%{$sqltargs},
producer => $db,
);
}
+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;
my $dir = $self->script_directory;
- return if $self->ignore_ddl;
-
my $schema_version = $self->schema_version;
my $diff_file_method = "_ddl_schema_${direction}_produce_filename";
foreach my $db (@$databases) {
}
open my $file, q(>), $diff_file;
- print {$file} join ";\n", @{$self->_sqldiff_from_yaml($from_version, $to_version, $db)};
+ print {$file} join ";\n", @{$self->_sqldiff_from_yaml($from_version, $to_version, $db, $direction)};
close $file;
}
}
my $version_set = (shift @_)->{version_set};
Dlog_info { "downgrade_single_step'ing $_" } $version_set;
+ my $sqlt_type = $self->storage->sqlt_type;
+ my $sql_to_run;
+ if ($self->ignore_ddl) {
+ $sql_to_run = $self->_sqldiff_from_yaml(
+ $version_set->[0], $version_set->[1], $sqlt_type, 'down',
+ );
+ }
my $sql = $self->_run_sql_and_perl($self->_ddl_schema_down_consume_filenames(
- $self->storage->sqlt_type,
+ $sqlt_type,
$version_set,
- ));
+ ), $sql_to_run);
return ['', $sql];
}
my $version_set = (shift @_)->{version_set};
Dlog_info { "upgrade_single_step'ing $_" } $version_set;
+ my $sqlt_type = $self->storage->sqlt_type;
+ my $sql_to_run;
+ if ($self->ignore_ddl) {
+ $sql_to_run = $self->_sqldiff_from_yaml(
+ $version_set->[0], $version_set->[1], $sqlt_type, 'up',
+ );
+ }
my $sql = $self->_run_sql_and_perl($self->_ddl_schema_up_consume_filenames(
- $self->storage->sqlt_type,
+ $sqlt_type,
$version_set,
- ));
+ ), $sql_to_run);
return ['', $sql];
}
like the best way to describe the layout is with the following example:
$sql_migration_dir
+ |- _protoschema
+ | |- schema
+ | |- 1
+ | | `- 001-auto.yml
+ | |- 2
+ | | `- 001-auto.yml
+ | `- 3
+ | `- 001-auto.yml
|- SQLite
| |- down
| | `- 2-1
| `- up
| `- 1-2
| `- 002-generate-customers.pl
- |- _generic
- | |- down
- | | `- 2-1
- | | `- 001-auto.sql
- | |- schema
- | | `- 1
- | | `- 001-auto.sql
- | `- up
- | `- 1-2
- | |- 001-auto.sql
- | `- 002-create-stored-procedures.sql
`- MySQL
|- down
| `- 2-1
C<.pl> files don't have to be in the C<_common> directory, but most of the time
they should be, because perl scripts are generally be database independent.
-C<_generic> exists for when you for some reason are sure that your SQL is
-generic enough to run on all databases. Good luck with that one.
-
Note that unlike most steps in the process, C<preinstall> will not run SQL, as
there may not even be an database at preinstall time. It will run perl scripts
just like the other steps in the process, but nothing is passed to them.
of preinstall is to have it prompt for username and password, and then call the
appropriate C<< CREATE DATABASE >> commands etc.
+=head2 Directory Specification
+
+The following subdirectories are recognized by this DeployMethod:
+
+=over 2
+
+=item C<_protoschema> This directory can contain the following directories:
+
+=over 2
+
+=item C<down> This directory merely contains directories named after
+migrations, which are of the form C<$from_version-$to_version>. Inside of
+these directories you may put Perl scripts which are to return a subref
+that takes the arguments C<< $from_schema, $to_schema >>, which are
+L<SQL::Translator::Schema> objects.
+
+=item C<up> This directory merely contains directories named after
+migrations, which are of the form C<$from_version-$to_version>. Inside of
+these directories you may put Perl scripts which are to return a subref
+that takes the arguments C<< $from_schema, $to_schema >>, which are
+L<SQL::Translator::Schema> objects.
+
+=item C<schema> This directory merely contains directories named after schema
+versions, which in turn contain C<yaml> files that are serialized versions
+of the schema at that version. These files are not for editing by hand.
+
+=back
+
+=item C<$storage_type> This is a set of scripts that gets run depending on what
+your storage type is. If you are not sure what your storage type is, take a
+look at the producers listed for L<SQL::Translator>. Also note, C<_common>
+is a special case. C<_common> will get merged into whatever other files you
+already have. This directory can containt the following directories itself:
+
+=over 2
+
+=item C<preinstall> Gets run before the C<schema> is C<deploy>ed. Has the
+same structure as the C<schema> subdirectory as well; that is, it has a
+directory for each schema version. Unlike C<schema>, C<up>, and C<down>
+though, it can only run C<.pl> files, and the coderef in the perl files get
+no arguments passed to them.
+
+=item C<schema> Gets run when the schema is C<deploy>ed. Structure is a
+directory per schema version, and then files are merged with C<_common> and run
+in filename order. C<.sql> files are merely run, as expected. C<.pl> files are
+run according to L</PERL SCRIPTS>.
+
+=item C<up> Gets run when the schema is C<upgrade>d. Structure is a directory
+per upgrade step, (for example, C<1-2> for upgrading from version 1 to version
+2,) and then files are merged with C<_common> and run in filename order.
+C<.sql> files are merely run, as expected. C<.pl> files are run according
+to L</PERL SCRIPTS>.
+
+=item C<down> Gets run when the schema is C<downgrade>d. Structure is a directory
+per downgrade step, (for example, C<2-1> for downgrading from version 2 to version
+1,) and then files are merged with C<_common> and run in filename order.
+C<.sql> files are merely run, as expected. C<.pl> files are run according
+to L</PERL SCRIPTS>.
+
+
+=back
+
+=back
+
=head1 PERL SCRIPTS
A perl script for this tool is very simple. It merely needs to contain an
projects / dbsrgits/DBIx-Class-DeploymentHandler.git / blobdiff