X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FDeploymentHandler.pm;h=988adc131160fbb50decbdbd463cb0fd66d5a0f3;hb=7f50d101838b1cb69f53128fa658b6039bd0d3ce;hp=d4d2db525016526e5810e210e4900fce097ab35b;hpb=8636376a862a6e3cdc4a2b4368ef90924e2d7609;p=dbsrgits%2FDBIx-Class-DeploymentHandler.git diff --git a/lib/DBIx/Class/DeploymentHandler.pm b/lib/DBIx/Class/DeploymentHandler.pm index d4d2db5..988adc1 100644 --- a/lib/DBIx/Class/DeploymentHandler.pm +++ b/lib/DBIx/Class/DeploymentHandler.pm @@ -6,6 +6,22 @@ require DBIx::Class::Schema; # loaded for type constraint require DBIx::Class::Storage; # loaded for type constraint require DBIx::Class::ResultSet; # loaded for type constraint use Carp::Clan '^DBIx::Class::DeploymentHandler'; +use SQL::Translator; +require SQL::Translator::Diff; +use Try::Tiny; + +with 'DBIx::Class::DeploymentHandler::WithSqltDeployMethod'; + +BEGIN { + use Moose::Util::TypeConstraints; + subtype 'DBIx::Class::DeploymentHandler::Databases' + => as 'ArrayRef[Str]'; + + coerce 'DBIx::Class::DeploymentHandler::Databases' + => from 'Str' + => via { [$_] }; + no Moose::Util::TypeConstraints; +} has schema => ( isa => 'DBIx::Class::Schema', @@ -14,16 +30,17 @@ has schema => ( handles => [qw( ddl_filename schema_version )], ); -has upgrade_directory => ( +has upgrade_directory => ( # configuration isa => 'Str', is => 'ro', required => 1, default => 'sql', ); -has backup_directory => ( +has backup_directory => ( # configuration isa => 'Str', is => 'ro', + predicate => 'has_backup_directory', ); has storage => ( @@ -38,18 +55,7 @@ method _build_storage { $s } -has _filedata => ( - isa => 'ArrayRef[Str]', - is => 'rw', -); - -has do_backup => ( - isa => 'Bool', - is => 'ro', - default => undef, -); - -has do_diff_on_init => ( +has do_backup => ( # configuration isa => 'Bool', is => 'ro', default => undef, @@ -67,9 +73,18 @@ method _build_version_rs { $self->schema->resultset('__VERSION') } -method backup { $self->storage->backup($self->backup_directory) } +has databases => ( # configuration + coerce => 1, + isa => 'DBIx::Class::DeploymentHandler::Databases', + is => 'ro', + default => sub { [qw( MySQL SQLite PostgreSQL )] }, +); -method create_ddl_dir { $self->storage->create_ddl_dir( $self->schema, @_ ) } +has sqltargs => ( # configuration + isa => 'HashRef', + is => 'ro', + default => sub { {} }, +); method install($new_version) { carp 'Install not possible as versions table already exists in database' @@ -78,7 +93,7 @@ method install($new_version) { $new_version ||= $self->schema_version; if ($new_version) { - $self->schema->deploy; + $self->deploy; $self->version_rs->create({ version => $new_version, @@ -88,8 +103,6 @@ method install($new_version) { } } -method create_upgrade_path { } - method ordered_schema_versions { undef } method upgrade { @@ -131,78 +144,10 @@ method upgrade { } } -method upgrade_single_step($db_version, $target_version) { - if ($db_version eq $target_version) { - # croak? - carp "Upgrade not necessary\n"; - return; - } - - my $upgrade_file = $self->ddl_filename( - $self->storage->sqlt_type, - $target_version, - $self->upgrade_directory, - $db_version, - ); - - $self->create_upgrade_path({ upgrade_file => $upgrade_file }); - - unless (-f $upgrade_file) { - # croak? - carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n"; - return; - } - - carp "DB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n"; - - $self->_filedata($self->_read_sql_file($upgrade_file)); # I don't like this --fREW 2010-02-22 - $self->backup if $self->do_backup; - $self->schema->txn_do(sub { $self->do_upgrade }); - - $self->version_rs->create({ - version => $target_version, - # ddl => $ddl, - # upgrade_sql => $upgrade_sql, - }); -} - -method do_upgrade { $self->run_upgrade(qr/.*?/) } - -method run_upgrade($stm) { - return unless $self->_filedata; - my @statements = grep { $_ =~ $stm } @{$self->_filedata}; - - for (@statements) { - $self->storage->debugobj->query_start($_) if $self->storage->debug; - $self->apply_statement($_); - $self->storage->debugobj->query_end($_) if $self->storage->debug; - } -} - -method apply_statement($statement) { - # croak? - $self->storage->dbh->do($_) or carp "SQL was: $_" -} - -method _read_sql_file($file) { - return unless $file; - - open my $fh, '<', $file or carp("Can't open upgrade file, $file ($!)"); - my @data = split /\n/, join '', <$fh>; - close $fh; - - @data = grep { - $_ && - !/^--/ && - !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/m - } split /;/, - join '', @data; - - return \@data; -} +__PACKAGE__->meta->make_immutable; 1; __END__ -vim: ts=2,sw=2,expandtab +vim: ts=2 sw=2 expandtab