X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FDeploymentHandler%2FDeployMethod%2FSQL%2FTranslator.pm;h=cb07a895c3bf678577042dbb1f9daa5bc225ef79;hb=4d09f7120015cc9b9f50fb80931be05572492229;hp=b43b070e6162b2c457ee9a0c755ed2f29ffe6ca7;hpb=398b13859e8cb5ba7fbeb3135b54446dac43cddd;p=dbsrgits%2FDBIx-Class-DeploymentHandler.git diff --git a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm index b43b070..cb07a89 100644 --- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm +++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm @@ -97,7 +97,7 @@ method __ddl_consume_with_prefix($type, $versions, $prefix) { } opendir my($dh), $dir; - my %files = map { $_ => "$dir/$_" } grep { /\.(?:sql|pl)$/ && -f "$dir/$_" } readdir $dh; + my %files = map { $_ => "$dir/$_" } grep { /\.(?:sql|pl|sql-\w+)$/ && -f "$dir/$_" } readdir $dh; closedir $dh; if (-d $common) { @@ -153,49 +153,74 @@ method _ddl_schema_down_produce_filename($type, $versions, $dir) { return catfile( $dirname, '001-auto.sql'); } -method _run_sql_and_perl($filenames) { - my @files = @{$filenames}; +method _run_sql_array($sql) { my $storage = $self->storage; + log_trace { '[DBICDH] Running SQL ' . Dumper($sql) }; + foreach my $line (@{$sql}) { + $storage->_query_start($line); + try { + # do a dbh_do cycle here, as we need some error checking in + # place (even though we will ignore errors) + $storage->dbh_do (sub { $_[1]->do($line) }); + } + catch { + carp "$_ (running '${line}')" + } + $storage->_query_end($line); + } + return join "\n", @$sql +} - my $guard = $self->schema->txn_scope_guard if $self->txn_wrap; +method _run_sql($filename) { + log_debug { "[DBICDH] Running SQL from $filename" }; + return $self->_run_sql_array($self->_read_sql_file($filename)); +} - my $sql; - for my $filename (@files) { - if ($filename =~ /\.sql$/) { - log_debug { "[DBICDH] Running SQL from $filename" }; - my @sql = @{$self->_read_sql_file($filename)}; - $sql .= join "\n", @sql; - log_trace { "[DBICDH] Running SQL $sql" }; - - foreach my $line (@sql) { - $storage->_query_start($line); - try { - # do a dbh_do cycle here, as we need some error checking in - # place (even though we will ignore errors) - $storage->dbh_do (sub { $_[1]->do($line) }); - } - catch { - carp "$_ (running '${line}')" - } - $storage->_query_end($line); - } - } elsif ( $filename =~ /\.pl$/ ) { - log_debug { "[DBICDH] Running Perl from $filename" }; - my $filedata = do { local( @ARGV, $/ ) = $filename; <> }; +method _run_perl($filename) { + log_debug { "[DBICDH] Running Perl from $filename" }; + my $filedata = do { local( @ARGV, $/ ) = $filename; <> }; - no warnings 'redefine'; - my $fn = eval "$filedata"; - use warnings; - log_trace { '[DBICDH] Running Perl ' . Dumper($fn) }; + no warnings 'redefine'; + my $fn = eval "$filedata"; + use warnings; + log_trace { '[DBICDH] Running Perl ' . Dumper($fn) }; - if ($@) { - carp "$filename failed to compile: $@"; - } elsif (ref $fn eq 'CODE') { - $fn->($self->schema) + if ($@) { + carp "$filename failed to compile: $@"; + } elsif (ref $fn eq 'CODE') { + $fn->($self->schema) + } else { + carp "$filename should define an anonymouse sub that takes a schema but it didn't!"; + } +} +{ + my $json; + + method _run_serialized_sql($filename, $type) { + if ($type eq 'json') { + require JSON; + $json ||= JSON->new->pretty; + my @sql = @{$json->decode($filename)}; } else { - carp "$filename should define an anonymouse sub that takes a schema but it didn't!"; + croak "A file ($filename) got to deploy that wasn't sql or perl!"; } + } + +} + +method _run_sql_and_perl($filenames) { + my @files = @{$filenames}; + my $guard = $self->schema->txn_scope_guard if $self->txn_wrap; + + my $sql = ''; + for my $filename (@files) { + if ($filename =~ /\.sql$/) { + $sql .= $self->_run_sql($filename) + } elsif ( $filename =~ /\.sql-(\w+)$/ ) { + $sql .= $self->_run_serialized_sql($filename, $1) + } elsif ( $filename =~ /\.pl$/ ) { + $self->_run_perl($filename) } else { croak "A file ($filename) got to deploy that wasn't sql or perl!"; }