package DBIx::Class::DeploymentHandler::DeployMethod::SQL::Translator;
-use Moose;
+use Moo;
# ABSTRACT: Manage your SQL and Perl migrations in nicely laid out directories
+use Sub::Quote 'quote_sub';
+use MooX::Types::MooseLike::Base qw(ArrayRef Bool HashRef Str);
+
use autodie;
use Carp qw( carp croak );
-use DBIx::Class::DeploymentHandler::Logger;
-use Log::Contextual qw(:log :dlog), -package_logger =>
- DBIx::Class::DeploymentHandler::Logger->new({
- env_prefix => 'DBICDH'
- });
+use DBIx::Class::DeploymentHandler::LogImporter qw(:log :dlog);
use Context::Preserve;
use Try::Tiny;
use SQL::Translator;
require SQL::Translator::Diff;
-require DBIx::Class::Storage; # loaded for type constraint
-use DBIx::Class::DeploymentHandler::Types;
+use DBIx::Class::DeploymentHandler::Types 'Storage';
use File::Path 'mkpath';
use File::Spec::Functions;
with 'DBIx::Class::DeploymentHandler::HandlesDeploy';
has ignore_ddl => (
- isa => 'Bool',
+ isa => Bool,
is => 'ro',
- default => undef,
);
has force_overwrite => (
- isa => 'Bool',
+ isa => Bool,
is => 'ro',
- default => undef,
);
has schema => (
- isa => 'DBIx::Class::Schema',
is => 'ro',
required => 1,
);
has storage => (
- isa => 'DBIx::Class::Storage',
+ isa => Storage,
is => 'ro',
- lazy_build => 1,
+ builder => '_build_storage',
);
sub _build_storage {
}
has sql_translator_args => (
- isa => 'HashRef',
+ isa => HashRef,
is => 'ro',
- default => sub { {} },
+ default => quote_sub(q( {} )),
);
+
has script_directory => (
- isa => 'Str',
+ isa => Str,
is => 'ro',
- required => 1,
- default => 'sql',
+ default => quote_sub(q{ 'sql' }),
);
has databases => (
- coerce => 1,
- isa => 'DBIx::Class::DeploymentHandler::Databases',
is => 'ro',
- default => sub { [qw( MySQL SQLite PostgreSQL )] },
+ #isa => ArrayRef[Str],
+ #coerce => quote_sub(q{
+ #if (ref(\$_[0]) eq 'SCALAR') {
+ #return [$_[0]]
+ #} else {
+ #return $_[0]
+ #}
+ #}),
+ default => quote_sub(q{ [qw( MySQL SQLite PostgreSQL )] }),
);
has txn_wrap => (
is => 'ro',
- isa => 'Bool',
- default => 1,
+ isa => Bool,
+ default => quote_sub(q{ 1 }),
);
has schema_version => (
is => 'ro',
- isa => 'Str',
- lazy_build => 1,
+ isa => Str,
+ builder => '_build_schema_version',
);
# this will probably never get called as the DBICDH
return $self->_run_sql_array($self->_read_sql_file($filename));
}
-# stolen from Plack::Util::_load_sandbox
sub _load_sandbox {
my $_file = shift;
my $_package = $_file;
- $_package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", unpack("C", $1))/eg;
-
- local $0 = $_file; # so FindBin etc. works
+ $_package =~ s/([^A-Za-z0-9_])/sprintf("_%2x", ord($1))/eg;
- return eval sprintf <<'END_EVAL', $_package;
+ my $fn = eval sprintf <<'END_EVAL', $_package;
package DBICDH::Sandbox::%s;
{
- my $app = do $_file;
+ our $app;
+ $app ||= require $_file;
if ( !$app && ( my $error = $@ || $! )) { die $error; }
$app;
}
END_EVAL
+
+ croak $@ if $@;
+
+ croak "$_file should define an anonymous sub that takes a schema but it didn't!"
+ unless ref $fn && ref $fn eq 'CODE';
+
+ return $fn;
}
sub _run_perl {
my ($self, $filename, $versions) = @_;
log_debug { "Running Perl from $filename" };
- my $filedata = do { local( @ARGV, $/ ) = $filename; <> };
my $fn = _load_sandbox($filename);
Dlog_trace { "Running Perl $_" } $fn;
- if (ref $fn eq 'CODE') {
- $fn->($self->schema, $versions)
- } else {
- croak "$filename should define an anonymouse sub that takes a schema but it didn't!";
- }
+ $fn->($self->schema, $versions)
}
sub txn_do {
my $from_file = shift;
my $to_file = shift;
my $dir = $self->script_directory;
- my $databases = $self->databases;
+ my $databases = ref $self->databases ? $self->databases : [$self->databases];
my $version = $self->schema_version;
foreach my $db (@$databases) {
sub _prepare_changegrade {
my ($self, $from_version, $to_version, $version_set, $direction) = @_;
my $schema = $self->schema;
- my $databases = $self->databases;
+ my $databases = ref $self->databases ? $self->databases : [$self->databases];
my $dir = $self->script_directory;
my $schema_version = $self->schema_version;