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";
+ if ($self->ignore_ddl) {
+ return []
+ } else {
+ croak "$main does not exist; please write/generate some SQL"
+ }
}
my %files;
}
method _ddl_schema_consume_filenames($type, $version) {
- $self->__ddl_consume_with_prefix($type, [ $version ], 'schema')
+ $self->__ddl_consume_with_prefix($type, [ $version ], 'deploy')
+}
+
+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, '_protoschema', $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, 'schema', $version );
+ my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
mkpath($dirname) unless -d $dirname;
return catfile( $dirname, '001-auto.sql' );
}
-method _ddl_schema_up_consume_filenames($type, $versions) {
- $self->__ddl_consume_with_prefix($type, $versions, 'up')
+method _ddl_schema_upgrade_consume_filenames($type, $versions) {
+ $self->__ddl_consume_with_prefix($type, $versions, 'upgrade')
}
-method _ddl_schema_down_consume_filenames($type, $versions) {
- $self->__ddl_consume_with_prefix($type, $versions, 'down')
+method _ddl_schema_downgrade_consume_filenames($type, $versions) {
+ $self->__ddl_consume_with_prefix($type, $versions, 'downgrade')
}
-method _ddl_schema_up_produce_filename($type, $versions) {
+method _ddl_schema_upgrade_produce_filename($type, $versions) {
my $dir = $self->script_directory;
- my $dirname = catfile( $dir, $type, 'up', join q(-), @{$versions});
+ my $dirname = catfile( $dir, $type, 'upgrade', join q(-), @{$versions});
mkpath($dirname) unless -d $dirname;
return catfile( $dirname, '001-auto.sql' );
}
-method _ddl_schema_down_produce_filename($type, $versions, $dir) {
- my $dirname = catfile( $dir, $type, 'down', join q(-), @{$versions} );
+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 _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 ($self, $source_name) = @_;
return sub {
my ($self, $type, $version) = @_;
- my $dirname = catfile( $self->script_directory, $type, 'schema', $version );
+ my $dirname = catfile( $self->script_directory, $type, 'deploy', $version );
mkpath($dirname) unless -d $dirname;
return catfile( $dirname, "001-auto-$source_name.sql" );
my ($self, $source_name) = @_;
return sub {
my ($self, $version) = @_;
- my $dirname = catfile( $self->script_directory, '_protoschema', $version );
+ my $dirname = catfile( $self->script_directory, '_source', $version );
mkpath($dirname) unless -d $dirname;
return catfile( $dirname, "001-auto-$source_name.yml" );
"preparing upgrade from $args->{from_version} to $args->{to_version}"
};
$self->_prepare_changegrade(
- $args->{from_version}, $args->{to_version}, $args->{version_set}, 'up'
+ $args->{from_version}, $args->{to_version}, $args->{version_set}, 'upgrade'
);
}
"preparing downgrade from $args->{from_version} to $args->{to_version}"
};
$self->_prepare_changegrade(
- $args->{from_version}, $args->{to_version}, $args->{version_set}, 'down'
+ $args->{from_version}, $args->{to_version}, $args->{version_set}, 'downgrade'
);
}
+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)};
+ print {$file} join ";\n", @{$self->_sqldiff_from_yaml($from_version, $to_version, $db, $direction)};
close $file;
}
}
my $sql_to_run;
if ($self->ignore_ddl) {
$sql_to_run = $self->_sqldiff_from_yaml(
- $version_set->[0], $version_set->[1], $sqlt_type
+ $version_set->[0], $version_set->[1], $sqlt_type, 'downgrade',
);
}
- my $sql = $self->_run_sql_and_perl($self->_ddl_schema_down_consume_filenames(
+ my $sql = $self->_run_sql_and_perl($self->_ddl_schema_downgrade_consume_filenames(
$sqlt_type,
$version_set,
), $sql_to_run);
my $sql_to_run;
if ($self->ignore_ddl) {
$sql_to_run = $self->_sqldiff_from_yaml(
- $version_set->[0], $version_set->[1], $sqlt_type
+ $version_set->[0], $version_set->[1], $sqlt_type, 'upgrade',
);
}
- my $sql = $self->_run_sql_and_perl($self->_ddl_schema_up_consume_filenames(
+ my $sql = $self->_run_sql_and_perl($self->_ddl_schema_upgrade_consume_filenames(
$sqlt_type,
$version_set,
), $sql_to_run);
=head1 DIRECTORY LAYOUT
-Arguably this is the best feature of L<DBIx::Class::DeploymentHandler>. It's
-heavily based upon L<DBIx::Migration::Directories>, but has some extensions and
-modifications, so even if you are familiar with it, please read this. I feel
-like the best way to describe the layout is with the following example:
+Arguably this is the best feature of L<DBIx::Class::DeploymentHandler>.
+It's spiritually based upon L<DBIx::Migration::Directories>, but has a
+lot of extensions and modifications, so even if you are familiar with it,
+please read this. I feel like the best way to describe the layout is with
+the following example:
$sql_migration_dir
+ |- _source
+ | |- deploy
+ | |- 1
+ | | `- 001-auto.yml
+ | |- 2
+ | | `- 001-auto.yml
+ | `- 3
+ | `- 001-auto.yml
|- SQLite
- | |- down
+ | |- downgrade
| | `- 2-1
| | `- 001-auto.sql
- | |- schema
+ | |- deploy
| | `- 1
| | `- 001-auto.sql
- | `- up
+ | `- upgrade
| |- 1-2
| | `- 001-auto.sql
| `- 2-3
| `- 001-auto.sql
|- _common
- | |- down
+ | |- downgrade
| | `- 2-1
| | `- 002-remove-customers.pl
- | `- up
+ | `- upgrade
| `- 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
+ |- downgrade
| `- 2-1
| `- 001-auto.sql
|- preinstall
| `- 1
| |- 001-create_database.pl
| `- 002-create_users_and_permissions.pl
- |- schema
+ |- deploy
| `- 1
| `- 001-auto.sql
- `- up
+ `- upgrade
`- 1-2
`- 001-auto.sql
$dm->deploy(1)
on an C<SQLite> database that would simply run
-C<$sql_migration_dir/SQLite/schema/1/001-auto.sql>. Next,
+C<$sql_migration_dir/SQLite/deploy/1/001-auto.sql>. Next,
$dm->upgrade_single_step([1,2])
-would run C<$sql_migration_dir/SQLite/up/1-2/001-auto.sql> followed by
-C<$sql_migration_dir/_common/up/1-2/002-generate-customers.pl>.
+would run C<$sql_migration_dir/SQLite/upgrade/1-2/001-auto.sql> followed by
+C<$sql_migration_dir/_common/upgrade/1-2/002-generate-customers.pl>.
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.
+they should be, because perl scripts are generally database independent.
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
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<_source> This directory can contain the following directories:
+
+=over 2
+
+=item C<deploy> 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<_preprocess_schema> This directory can contain the following
+directories:
+
+=over 2
+
+=item C<downgrade> 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<upgrade> 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.
+
+=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<deploy> is C<deploy>ed. Has the
+same structure as the C<deploy> subdirectory as well; that is, it has a
+directory for each schema version. Unlike C<deploy>, C<upgrade>, and C<downgrade>
+though, it can only run C<.pl> files, and the coderef in the perl files get
+no arguments passed to them.
+
+=item C<deploy> 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<upgrade> 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<downgrade> 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
})
}
+=attr ignore_ddl
+
+This attribute will, when set to true (default is false), cause the DM to use
+L<SQL::Translator> to use the C<_source>'s serialized SQL::Translator::Schema
+instead of any pregenerated SQL. If you have a development server this is
+probably the best plan of action as you will not be putting as many generated
+files in your version control. Goes well with with C<databases> of C<[]>.
+
=attr schema
The L<DBIx::Class::Schema> (B<required>) that is used to talk to the database
The version the schema on your harddrive is at. Defaults to
C<< $self->schema->schema_version >>.
-
-=begin comment
-
-=head2 __ddl_consume_with_prefix
-
- $dm->__ddl_consume_with_prefix( 'SQLite', [qw( 1.00 1.01 )], 'up' )
-
-This is the meat of the multi-file upgrade/deploy stuff. It returns a list of
-files in the order that they should be run for a generic "type" of upgrade.
-You should not be calling this in user code.
-
-=head2 _ddl_schema_consume_filenames
-
- $dm->__ddl_schema_consume_filenames( 'SQLite', [qw( 1.00 )] )
-
-Just a curried L</__ddl_consume_with_prefix>. Get's a list of files for an
-initial deploy.
-
-=head2 _ddl_schema_produce_filename
-
- $dm->__ddl_schema_produce_filename( 'SQLite', [qw( 1.00 )] )
-
-Returns a single file in which an initial schema will be stored.
-
-=head2 _ddl_schema_up_consume_filenames
-
- $dm->_ddl_schema_up_consume_filenames( 'SQLite', [qw( 1.00 )] )
-
-Just a curried L</__ddl_consume_with_prefix>. Get's a list of files for an
-upgrade.
-
-=head2 _ddl_schema_down_consume_filenames
-
- $dm->_ddl_schema_down_consume_filenames( 'SQLite', [qw( 1.00 )] )
-
-Just a curried L</__ddl_consume_with_prefix>. Get's a list of files for a
-downgrade.
-
-=head2 _ddl_schema_up_produce_filenames
-
- $dm->_ddl_schema_up_produce_filename( 'SQLite', [qw( 1.00 1.01 )] )
-
-Returns a single file in which the sql to upgrade from one schema to another
-will be stored.
-
-=head2 _ddl_schema_down_produce_filename
-
- $dm->_ddl_schema_down_produce_filename( 'SQLite', [qw( 1.00 1.01 )] )
-
-Returns a single file in which the sql to downgrade from one schema to another
-will be stored.
-
-=head2 _resultsource_install_filename
-
- my $filename_fn = $dm->_resultsource_install_filename('User');
- $dm->$filename_fn('SQLite', '1.00')
-
-Returns a function which in turn returns a single filename used to install a
-single resultsource. Weird interface is convenient for me. Deal with it.
-
-=head2 _run_sql_and_perl
-
- $dm->_run_sql_and_perl([qw( list of filenames )])
-
-Simply put, this runs the list of files passed to it. If the file ends in
-C<.sql> it runs it as sql and if it ends in C<.pl> it runs it as a perl file.
-
-Depending on L</txn_wrap> all of the files run will be wrapped in a single
-transaction.
-
-=head2 _prepare_install
-
- $dm->_prepare_install({ add_drop_table => 0 }, sub { 'file_to_create' })
-
-Generates the sql file for installing the database. First arg is simply
-L<SQL::Translator> args and the second is a coderef that returns the filename
-to store the sql in.
-
-=head2 _prepare_changegrade
-
- $dm->_prepare_changegrade('1.00', '1.01', [qw( 1.00 1.01)], 'up')
-
-Generates the sql file for migrating from one schema version to another. First
-arg is the version to start from, second is the version to go to, third is the
-L<version set|DBIx::Class::DeploymentHandler/VERSION SET>, and last is the
-direction of the changegrade, be it 'up' or 'down'.
-
-=head2 _read_sql_file
-
- $dm->_read_sql_file('foo.sql')
-
-Reads a sql file and returns lines in an C<ArrayRef>. Strips out comments,
-transactions, and blank lines.
-
-=end comment
projects / dbsrgits/DBIx-Class-DeploymentHandler.git / blobdiff