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;
|- downgrade
| `- 2-1
| `- 001-auto.sql
- |- preinstall
+ |- initialize
| `- 1
| |- 001-create_database.pl
| `- 002-create_users_and_permissions.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 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<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
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
projects / dbsrgits/DBIx-Class-DeploymentHandler.git / blobdiff