X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FDeploymentHandler%2FDeployMethod%2FSQL%2FTranslator.pm;h=c2bbc473a7ce10e671b559f3ce1998315f12c206;hb=7e08eddd832a00dbe52d8f1ba90ea486c48f7ab1;hp=cb07a895c3bf678577042dbb1f9daa5bc225ef79;hpb=4d09f7120015cc9b9f50fb80931be05572492229;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 cb07a89..c2bbc47 100644 --- a/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm +++ b/lib/DBIx/Class/DeploymentHandler/DeployMethod/SQL/Translator.pm @@ -5,11 +5,11 @@ use Moose; use autodie; use Carp qw( carp croak ); -use Log::Contextual::WarnLogger; -use Log::Contextual qw(:log :dlog), -default_logger => Log::Contextual::WarnLogger->new({ - env_prefix => 'DBICDH' -}); -use Data::Dumper::Concise; +use DBIx::Class::DeploymentHandler::Logger; +use Log::Contextual qw(:log :dlog), -default_logger => + DBIx::Class::DeploymentHandler::Logger->new({ + env_prefix => 'DBICDH' + }); use Method::Signatures::Simple; use Try::Tiny; @@ -121,6 +121,13 @@ method _ddl_schema_consume_filenames($type, $version) { $self->__ddl_consume_with_prefix($type, [ $version ], 'schema') } +method _ddl_protoschema_produce_filename($version) { + my $dirname = catfile( $self->script_directory, '_protoschema', $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 ); mkpath($dirname) unless -d $dirname; @@ -156,16 +163,23 @@ method _ddl_schema_down_produce_filename($type, $versions, $dir) { method _run_sql_array($sql) { my $storage = $self->storage; - log_trace { '[DBICDH] Running SQL ' . Dumper($sql) }; + $sql = [grep { + $_ && # remove blank lines + !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/ # strip txn's + } map { + s/^\s+//; s/\s+$//; # trim whitespace + join '', grep { !/^--/ } split /\n/ # remove comments + } @$sql]; + + Dlog_trace { "Running SQL $_" } $sql; foreach my $line (@{$sql}) { $storage->_query_start($line); + # the whole reason we do this is so that we can see the line that was run 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}')" + die "$_ (running line '$line')" } $storage->_query_end($line); } @@ -173,18 +187,18 @@ method _run_sql_array($sql) { } method _run_sql($filename) { - log_debug { "[DBICDH] Running SQL from $filename" }; + log_debug { "Running SQL from $filename" }; return $self->_run_sql_array($self->_read_sql_file($filename)); } method _run_perl($filename) { - log_debug { "[DBICDH] Running Perl from $filename" }; + log_debug { "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) }; + Dlog_trace { "Running Perl $_" } $fn; if ($@) { carp "$filename failed to compile: $@"; @@ -234,7 +248,7 @@ method _run_sql_and_perl($filenames) { sub deploy { my $self = shift; my $version = (shift @_ || {})->{version} || $self->schema_version; - log_info { "[DBICDH] deploying version $version" }; + log_info { "deploying version $version" }; return $self->_run_sql_and_perl($self->_ddl_schema_consume_filenames( $self->storage->sqlt_type, @@ -246,7 +260,7 @@ sub preinstall { my $self = shift; my $args = shift; my $version = $args->{version} || $self->schema_version; - log_info { "[DBICDH] preinstalling version $version" }; + log_info { "preinstalling version $version" }; my $storage_type = $args->{storage_type} || $self->storage->sqlt_type; my @files = @{$self->_ddl_preinstall_consume_filenames( @@ -287,18 +301,14 @@ sub _prepare_install { my $sqlt = SQL::Translator->new({ add_drop_table => 1, - ignore_constraint_names => 1, - ignore_index_names => 1, - parser => 'SQL::Translator::Parser::DBIx::Class', + parser => 'SQL::Translator::Parser::YAML', %{$sqltargs} }); - my $sqlt_schema = $sqlt->translate( data => $schema ) - or croak($sqlt->error); + my $yaml_filename = $self->_ddl_protoschema_produce_filename($version); foreach my $db (@$databases) { $sqlt->reset; - $sqlt->{schema} = $sqlt_schema; $sqlt->producer($db); my $filename = $self->$to_file($db, $version, $dir); @@ -307,13 +317,13 @@ sub _prepare_install { unlink $filename; } - my $output = $sqlt->translate; - if(!$output) { + my $sql = $sqlt->translate($yaml_filename); + if(!$sql) { carp("Failed to translate to $db, skipping. (" . $sqlt->error . ")"); next; } open my $file, q(>), $filename; - print {$file} $output; + print {$file} $sql; close $file; } } @@ -333,7 +343,7 @@ sub install_resultsource { my ($self, $args) = @_; my $source = $args->{result_source}; my $version = $args->{version}; - log_info { '[DBICDH] installing_resultsource ' . $source->source_name . ", version $version" }; + log_info { 'installing_resultsource ' . $source->source_name . ", version $version" }; my $rs_install_file = $self->_resultsource_install_filename($source->source_name); @@ -349,7 +359,7 @@ sub install_resultsource { sub prepare_resultsource_install { my $self = shift; my $source = (shift @_)->{result_source}; - log_info { '[DBICDH] preparing install for resultsource ' . $source->source_name }; + log_info { 'preparing install for resultsource ' . $source->source_name }; my $filename = $self->_resultsource_install_filename($source->source_name); $self->_prepare_install({ @@ -358,16 +368,16 @@ sub prepare_resultsource_install { } sub prepare_deploy { - log_info { '[DBICDH] preparing deploy' }; + log_info { 'preparing deploy' }; my $self = shift; + $self->_generate_protoschema; $self->_prepare_install({}, '_ddl_schema_produce_filename'); } sub prepare_upgrade { my ($self, $args) = @_; log_info { - '[DBICDH] preparing upgrade ' . - "from $args->{from_version} to $args->{to_version}" + "preparing upgrade from $args->{from_version} to $args->{to_version}" }; $self->_prepare_changegrade( $args->{from_version}, $args->{to_version}, $args->{version_set}, 'up' @@ -377,8 +387,7 @@ sub prepare_upgrade { sub prepare_downgrade { my ($self, $args) = @_; log_info { - '[DBICDH] preparing downgrade ' . - "from $args->{from_version} to $args->{to_version}" + "preparing downgrade from $args->{from_version} to $args->{to_version}" }; $self->_prepare_changegrade( $args->{from_version}, $args->{to_version}, $args->{version_set}, 'down' @@ -500,7 +509,7 @@ method _read_sql_file($file) { sub downgrade_single_step { my $self = shift; my $version_set = (shift @_)->{version_set}; - log_info { qq([DBICDH] downgrade_single_step'ing ) . Dumper($version_set) }; + Dlog_info { "downgrade_single_step'ing $_" } $version_set; my $sql = $self->_run_sql_and_perl($self->_ddl_schema_down_consume_filenames( $self->storage->sqlt_type, @@ -513,7 +522,7 @@ sub downgrade_single_step { sub upgrade_single_step { my $self = shift; my $version_set = (shift @_)->{version_set}; - log_info { qq([DBICDH] upgrade_single_step'ing ) . Dumper($version_set) }; + Dlog_info { "upgrade_single_step'ing $_" } $version_set; my $sql = $self->_run_sql_and_perl($self->_ddl_schema_up_consume_filenames( $self->storage->sqlt_type, @@ -522,6 +531,33 @@ sub upgrade_single_step { return ['', $sql]; } +sub _generate_protoschema { + my $self = shift; + my $filename + = $self->_ddl_protoschema_produce_filename($self->schema_version); + + my $sqlt = SQL::Translator->new({ + parser => 'SQL::Translator::Parser::DBIx::Class', + producer => 'SQL::Translator::Producer::YAML', + parser_args => { package => $self->schema }, + %{ $self->sql_translator_args } + }); + + my $yml = $sqlt->translate; + + croak("Failed to translate to YAML: " . $sqlt->error) + unless $yml; + + if (-e $filename ) { + carp "Overwriting existing DDL-YML file - $filename"; + unlink $filename; + } + + open my $file, q(>), $filename; + print {$file} $yml; + close $file; +} + __PACKAGE__->meta->make_immutable; 1; @@ -532,12 +568,13 @@ __END__ =head1 DESCRIPTION -This class is the meat of L. It takes care of -generating sql files representing schemata as well as sql files to move from -one version of a schema to the rest. One of the hallmark features of this -class is that it allows for multiple sql files for deploy and upgrade, allowing -developers to fine tune deployment. In addition it also allows for perl files -to be run at any stage of the process. +This class is the meat of L. It takes +care of generating serialized sql files representing schemata as well +as serialized sql files to move from one version of a schema to the rest. +One of the hallmark features of this class is that it allows for multiple sql +files for deploy and upgrade, allowing developers to fine tune deployment. +In addition it also allows for perl files to be run +at any stage of the process. For basic usage see L. What's documented here is extra fun stuff or private methods. @@ -553,15 +590,15 @@ like the best way to describe the layout is with the following example: |- SQLite | |- down | | `- 2-1 - | | `- 001-auto.sql + | | `- 001-auto.sql-json | |- schema | | `- 1 - | | `- 001-auto.sql + | | `- 001-auto.sql-json | `- up | |- 1-2 - | | `- 001-auto.sql + | | `- 001-auto.sql-json | `- 2-3 - | `- 001-auto.sql + | `- 001-auto.sql-json |- _common | |- down | | `- 2-1 @@ -572,44 +609,43 @@ like the best way to describe the layout is with the following example: |- _generic | |- down | | `- 2-1 - | | `- 001-auto.sql + | | `- 001-auto.sql-json | |- schema | | `- 1 - | | `- 001-auto.sql + | | `- 001-auto.sql-json | `- up | `- 1-2 - | |- 001-auto.sql + | |- 001-auto.sql-json | `- 002-create-stored-procedures.sql `- MySQL |- down | `- 2-1 - | `- 001-auto.sql + | `- 001-auto.sql-json |- preinstall | `- 1 | |- 001-create_database.pl | `- 002-create_users_and_permissions.pl |- schema | `- 1 - | `- 001-auto.sql + | `- 001-auto.sql-json `- up `- 1-2 - `- 001-auto.sql + `- 001-auto.sql-json So basically, the code $dm->deploy(1) on an C database that would simply run -C<$sql_migration_dir/SQLite/schema/1/001-auto.sql>. Next, +C<$sql_migration_dir/SQLite/schema/1/001-auto.sql-json>. Next, $dm->upgrade_single_step([1,2]) -would run C<$sql_migration_dir/SQLite/up/1-2/001-auto.sql> followed by +would run C<$sql_migration_dir/SQLite/up/1-2/001-auto.sql-json> followed by C<$sql_migration_dir/_common/up/1-2/002-generate-customers.pl>. -Now, a C<.pl> file doesn't have to be in the C<_common> directory, but most of -the time it probably should be, since perl scripts will mostly be database -independent. +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. @@ -621,6 +657,22 @@ 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 appropriate C<< CREATE DATABASE >> commands etc. +=head1 SERIALIZED SQL + +The SQL that this module generates and uses is serialized into an array of +SQL statements. The reason being that some databases handle multiple +statements in a single execution differently. Generally you do not need to +worry about this as these are scripts generated for you. If you find that +you are editing them on a regular basis something is wrong and you either need +to submit a bug or consider writing extra serialized SQL or Perl scripts to run +before or after the automatically generated script. + +B Currently the SQL is serialized into JSON. I am willing to merge in +patches that will allow more serialization formats if you want that feature, +but if you do send me a patch for that realize that I do not want to add YAML +support or whatever, I would rather add a generic method of adding any +serialization format. + =head1 PERL SCRIPTS A perl script for this tool is very simple. It merely needs to contain an