use autodie;
use Carp qw( carp croak );
use DBIx::Class::DeploymentHandler::Logger;
-use Log::Contextual qw(:log :dlog), -default_logger =>
+use Log::Contextual qw(:log :dlog), -package_logger =>
DBIx::Class::DeploymentHandler::Logger->new({
env_prefix => 'DBICDH'
});
default => undef,
);
+has force_overwrite => (
+ isa => 'Bool',
+ is => 'ro',
+ default => undef,
+);
+
has schema => (
isa => 'DBIx::Class::Schema',
is => 'ro',
return [@files{sort keys %files}]
}
-method _ddl_preinstall_consume_filenames($type, $version) {
- $self->__ddl_consume_with_prefix($type, [ $version ], 'preinstall')
+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;
}
catch {
die "$_ (running line '$line')"
- }
+ };
$storage->_query_end($line);
}
return join "\n", @$sql
my $sql;
if ($self->ignore_ddl) {
$sql = $self->_sql_from_yaml({},
- '_ddl_protoschema_produce_filename', $sqlt_type
+ '_ddl_protoschema_deploy_consume_filenames', $sqlt_type
);
}
return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames(
), $sql);
}
-sub preinstall {
+sub initialize {
my $self = shift;
my $args = shift;
my $version = $args->{version} || $self->schema_version;
- log_info { "preinstalling version $version" };
+ log_info { "initializing version $version" };
my $storage_type = $args->{storage_type} || $self->storage->sqlt_type;
- my @files = @{$self->_ddl_preinstall_consume_filenames(
+ my @files = @{$self->_ddl_initialize_consume_filenames(
$storage_type,
$version,
)};
carp "$filename should define an anonymous sub but it didn't!";
}
} else {
- croak "A file ($filename) got to preinstall_scripts that wasn't sql or perl!";
+ croak "A file ($filename) got to initialize_scripts that wasn't sql or perl!";
}
}
}
my $schema = $self->schema;
my $version = $self->schema_version;
- my $sqlt = SQL::Translator->new({
- add_drop_table => 0,
- parser => 'SQL::Translator::Parser::YAML',
- %{$sqltargs},
- producer => $db,
- });
-
- my $yaml_filename = $self->$from_file($version);
+ my @sql;
- my @sql = $sqlt->translate($yaml_filename);
- if(!@sql) {
- carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
- return undef;
+ my $actual_file = $self->$from_file($version);
+ for my $yaml_filename (@{
+ DlogS_trace { "generating SQL from Serialized SQL Files: $_" }
+ (ref $actual_file?$actual_file:[$actual_file])
+ }) {
+ my $sqlt = SQL::Translator->new({
+ add_drop_table => 0,
+ parser => 'SQL::Translator::Parser::YAML',
+ %{$sqltargs},
+ producer => $db,
+ });
+
+ push @sql, $sqlt->translate($yaml_filename);
+ if(!@sql) {
+ carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
+ return undef;
+ }
}
return \@sql;
}
my $filename = $self->$to_file($db, $version, $dir);
if (-e $filename ) {
- carp "Overwriting existing DDL file - $filename";
- unlink $filename;
+ if ($self->force_overwrite) {
+ carp "Overwriting existing DDL file - $filename";
+ unlink $filename;
+ } else {
+ die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
+ }
}
open my $file, q(>), $filename;
print {$file} join ";\n", @$sql;
my ($self, $source_name) = @_;
return sub {
my ($self, $version) = @_;
- my $dirname = catfile( $self->script_directory, '_source', $version );
+ my $dirname = catfile( $self->script_directory, '_source', 'deploy', $version );
mkpath($dirname) unless -d $dirname;
return catfile( $dirname, "001-auto-$source_name.yml" );
sub install_resultsource {
my ($self, $args) = @_;
- my $source = $args->{result_source};
- my $version = $args->{version};
+ my $source = $args->{result_source}
+ or die 'result_source must be passed to install_resultsource';
+ my $version = $args->{version}
+ or die 'version must be passed to install_resultsource';
log_info { 'installing_resultsource ' . $source->source_name . ", version $version" };
my $rs_install_file =
$self->_resultsource_install_filename($source->source_name);
sub prepare_deploy {
log_info { 'preparing deploy' };
my $self = shift;
- $self->prepare_protoschema({}, '_ddl_protoschema_produce_filename');
+ $self->prepare_protoschema({
+ # Exclude __VERSION so that it gets installed separately
+ parser_args => { sources => [grep { $_ ne '__VERSION' } $self->schema->sources], }
+ }, '_ddl_protoschema_produce_filename');
$self->_prepare_install({}, '_ddl_protoschema_produce_filename', '_ddl_schema_produce_filename');
}
foreach my $db (@$databases) {
my $diff_file = $self->$diff_file_method($db, $version_set, $dir );
if(-e $diff_file) {
- carp("Overwriting existing $direction-diff file - $diff_file");
- unlink $diff_file;
+ if ($self->force_overwrite) {
+ carp("Overwriting existing $direction-diff file - $diff_file");
+ unlink $diff_file;
+ } else {
+ die "Cannot overwrite '$diff_file', either enable force_overwrite or delete it"
+ }
}
open my $file, q(>), $diff_file;
unless $yml;
if (-e $filename ) {
- carp "Overwriting existing DDL-YML file - $filename";
- unlink $filename;
+ if ($self->force_overwrite) {
+ carp "Overwriting existing DDL-YML file - $filename";
+ unlink $filename;
+ } else {
+ die "Cannot overwrite '$filename', either enable force_overwrite or delete it"
+ }
}
open my $file, q(>), $filename;
=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
|- downgrade
| `- 2-1
| `- 001-auto.sql
- |- preinstall
+ |- initialize
| `- 1
| |- 001-create_database.pl
| `- 002-create_users_and_permissions.pl
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.
+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
+Note that unlike most steps in the process, C<initialize> will not run SQL, as
+there may not even be an database at initialize time. It will run perl scripts
just like the other steps in the process, but nothing is passed to them.
Until people have used this more it will remain freeform, but a recommended use
-of preinstall is to have it prompt for username and password, and then call the
+of initialize is to have it prompt for username and password, and then call the
appropriate C<< CREATE DATABASE >> commands etc.
=head2 Directory Specification
=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<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<$storage_type> This is a set of scripts that gets run depending on what
=over 2
-=item C<preinstall> Gets run before the C<deploy> is C<deploy>ed. Has the
+=item C<initialize> 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
})
}
+=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 force_overwrite
+
+When this attribute is true generated files will be overwritten when the
+methods which create such files are run again. The default is false, in which
+case the program will die with a message saying which file needs to be deleted.
+
=attr schema
The L<DBIx::Class::Schema> (B<required>) that is used to talk to the database