X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FDeploymentHandler.pm;h=c22b6ab3df6cbcc17b527de6df84659e0d32fdcc;hb=e217d19c58c8beba917e751dd1089281fa1a74ee;hp=c67fb920aa784eedbdd116f019bdcecaa055195e;hpb=334bced5e3d08a9f7fe0688c9c730c48c38e1550;p=dbsrgits%2FDBIx-Class-DeploymentHandler.git diff --git a/lib/DBIx/Class/DeploymentHandler.pm b/lib/DBIx/Class/DeploymentHandler.pm index c67fb92..c22b6ab 100644 --- a/lib/DBIx/Class/DeploymentHandler.pm +++ b/lib/DBIx/Class/DeploymentHandler.pm @@ -3,14 +3,11 @@ package DBIx::Class::DeploymentHandler; use Moose; use Method::Signatures::Simple; 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'; +with 'DBIx::Class::DeploymentHandler::WithDatabaseToSchemaVersions'; BEGIN { use Moose::Util::TypeConstraints; @@ -27,40 +24,22 @@ has schema => ( isa => 'DBIx::Class::Schema', is => 'ro', required => 1, - 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 => ( - isa => 'DBIx::Class::Storage', - is => 'ro', - lazy_build => 1, -); - -method _build_storage { - my $s = $self->schema->storage; - $s->_determine_driver; - $s -} - -has do_backup => ( - isa => 'Bool', - is => 'ro', - default => undef, -); - -has do_diff_on_init => ( +has do_backup => ( # configuration isa => 'Bool', is => 'ro', default => undef, @@ -69,70 +48,38 @@ has do_diff_on_init => ( has version_rs => ( isa => 'DBIx::Class::ResultSet', is => 'ro', - lazy_build => 1, - handles => [qw( is_installed db_version )], + lazy_build => 1, # builder comes from another role... + # which is... probably not how we want it + handles => [qw( is_installed )], ); -method _build_version_rs { - $self->schema->set_us_up_the_bomb; - $self->schema->resultset('__VERSION') -} +has to_version => ( # configuration + is => 'ro', + lazy_build => 1, # builder comes from another role... + # which is... probably not how we want it +); -has databases => ( +has databases => ( # configuration coerce => 1, isa => 'DBIx::Class::DeploymentHandler::Databases', is => 'ro', default => sub { [qw( MySQL SQLite PostgreSQL )] }, ); -has sqltargs => ( +has sqltargs => ( # configuration isa => 'HashRef', is => 'ro', default => sub { {} }, ); -method deploy { - my $schema = $self->schema; - my $type = undef; - my $sqltargs = $self->sqltargs; - my $dir = $self->upgrade_directory; - my $storage = $self->storage; - - my $deploy = sub { - my $line = shift; - return if(!$line || $line =~ /^--|^BEGIN TRANSACTION|^COMMIT|^\s+$/); - $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); - }; - my @statements = $self->deployment_statements(); - if (@statements > 1) { - foreach my $statement (@statements) { - $deploy->( $statement ); - } - } - elsif (@statements == 1) { - foreach my $line ( split(";\n", $statements[0])) { - $deploy->( $line ); - } - } -} - -method install($new_version) { +method install { carp 'Install not possible as versions table already exists in database' if $self->is_installed; - $new_version ||= $self->schema_version; + my $new_version = $self->to_version; if ($new_version) { - $self->deploy(); + $self->_deploy; $self->version_rs->create({ version => $new_version, @@ -142,51 +89,18 @@ method install($new_version) { } } -method ordered_schema_versions { undef } - -method upgrade { - my $db_version = $self->db_version; - my $schema_version = $self->schema_version; - - unless ($db_version) { - # croak? - carp 'Upgrade not possible as database is unversioned. Please call install first.'; - return; - } - - if ( $db_version eq $schema_version ) { - # croak? - carp "Upgrade not necessary\n"; - return; - } - - my @version_list = $self->ordered_schema_versions || - ( $db_version, $schema_version ); - - # remove all versions in list above the required version - while ( @version_list && ( $version_list[-1] ne $schema_version ) ) { - pop @version_list; - } - - # remove all versions in list below the current version - while ( @version_list && ( $version_list[0] ne $db_version ) ) { - shift @version_list; - } - - # check we have an appropriate list of versions - die if @version_list < 2; - - # do sets of upgrade - while ( @version_list >= 2 ) { - $self->upgrade_single_step( $version_list[0], $version_list[1] ); - shift @version_list; +sub upgrade { + while ( my $version_list = $_[0]->next_version_set ) { + $_[0]->_upgrade_single_step($version_list); } } +method backup { $self->storage->backup($self->backup_directory) } + __PACKAGE__->meta->make_immutable; 1; __END__ -vim: ts=2,sw=2,expandtab +vim: ts=2 sw=2 expandtab