X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FDeploymentHandler%2FDad.pm;h=d9e4b2749981813ebc1aa3e4b4f2acd5c0ff1ea4;hb=fe048ee301e219d737307f2b30e3bd88a7128df6;hp=db485b3c8320487165fb7e0d36122a047efd412f;hpb=cfc9edf93ec15cb3ae64af76905d96c89681f51b;p=dbsrgits%2FDBIx-Class-DeploymentHandler.git diff --git a/lib/DBIx/Class/DeploymentHandler/Dad.pm b/lib/DBIx/Class/DeploymentHandler/Dad.pm index db485b3..d9e4b27 100644 --- a/lib/DBIx/Class/DeploymentHandler/Dad.pm +++ b/lib/DBIx/Class/DeploymentHandler/Dad.pm @@ -1,15 +1,20 @@ package DBIx::Class::DeploymentHandler::Dad; +# ABSTRACT: Parent class for DeploymentHandlers + use Moose; -use Method::Signatures::Simple; require DBIx::Class::Schema; # loaded for type constraint use Carp::Clan '^DBIx::Class::DeploymentHandler'; +use DBIx::Class::DeploymentHandler::Logger; +use DBIx::Class::DeploymentHandler::Types; +use Log::Contextual ':log', -package_logger => + DBIx::Class::DeploymentHandler::Logger->new({ + env_prefix => 'DBICDH' + }); has schema => ( - isa => 'DBIx::Class::Schema', is => 'ro', required => 1, - handles => ['schema_version'], ); has backup_directory => ( @@ -20,52 +25,90 @@ has backup_directory => ( has to_version => ( is => 'ro', + isa => 'Str', + lazy_build => 1, +); + +sub _build_to_version { $_[0]->schema_version } + +has schema_version => ( + is => 'ro', + isa => 'StrSchemaVersion', lazy_build => 1, ); -sub _build_to_version { $_[0]->schema->schema_version } +sub _build_schema_version { $_[0]->schema->schema_version } + +sub install { + my $self = shift; -method install { + my $version = (shift @_ || {})->{version} || $self->to_version; + log_info { "installing version $version" }; croak 'Install not possible as versions table already exists in database' if $self->version_storage_is_installed; - my $ddl = $self->deploy; + $self->txn_do(sub { + my $ddl = $self->deploy({ version=> $version }); - $self->add_database_version({ - version => $self->to_version, - ddl => $ddl, + $self->add_database_version({ + version => $self->to_version, + ddl => $ddl, + }); }); } sub upgrade { + log_info { 'upgrading' }; my $self = shift; - while ( my $version_list = $self->next_version_set ) { - my ($ddl, $upgrade_sql) = @{$self->upgrade_single_step($version_list)||[]}; - - $self->add_database_version({ - version => $version_list->[-1], - ddl => $ddl, - upgrade_sql => $upgrade_sql, - }); - } + my $ran_once = 0; + $self->txn_do(sub { + while ( my $version_list = $self->next_version_set ) { + $ran_once = 1; + my ($ddl, $upgrade_sql) = @{ + $self->upgrade_single_step({ version_set => $version_list }) + ||[]}; + + $self->add_database_version({ + version => $version_list->[-1], + ddl => $ddl, + upgrade_sql => $upgrade_sql, + }); + } + }); + + log_warn { 'no need to run upgrade' } unless $ran_once; } sub downgrade { + log_info { 'downgrading' }; my $self = shift; - while ( my $version_list = $self->previous_version_set ) { - $self->downgrade_single_step($version_list); - - # do we just delete a row here? I think so but not sure - $self->delete_database_version({ version => $version_list->[-1] }); - } + my $ran_once = 0; + $self->txn_do(sub { + while ( my $version_list = $self->previous_version_set ) { + $ran_once = 1; + $self->downgrade_single_step({ version_set => $version_list }); + + # do we just delete a row here? I think so but not sure + $self->delete_database_version({ version => $version_list->[0] }); + } + }); + log_warn { 'no version to run downgrade' } unless $ran_once; } -method backup { $self->storage->backup($self->backup_directory) } +sub backup { + my $self = shift; + log_info { 'backing up' }; + $self->schema->storage->backup($self->backup_directory) +} __PACKAGE__->meta->make_immutable; 1; +# vim: ts=2 sw=2 expandtab + +__END__ + =pod =attr schema @@ -73,9 +116,14 @@ __PACKAGE__->meta->make_immutable; The L (B) that is used to talk to the database and generate the DDL. +=attr schema_version + +The version that the schema is currently at. Defaults to +C<< $self->schema->schema_version >>. + =attr backup_directory -The directory that backups are stored in +The directory where backups are stored =attr to_version @@ -85,10 +133,14 @@ The version (defaults to schema's version) to migrate the database to $dh->install -Deploys the current schema into the database. Populates C with -C and C. +or + + $dh->install({ version => 1 }) -B: you typically need to call C<< $dh->prepare_install >> before you call +Deploys the requested version into the database Version defaults to +L. Populates C with C and C. + +B: you typically need to call C<< $dh->prepare_deploy >> before you call this method. B: you cannot install on top of an already installed database @@ -107,7 +159,7 @@ returned from L. $dh->downgrade Downgrades the database one step at a time till L -returns C. Each downgrade step will delete a Cfrom the +returns C. Each downgrade step will delete a C from the version storage. =method backup @@ -120,72 +172,84 @@ assuming it will work. =head1 METHODS THAT ARE REQUIRED IN SUBCLASSES +=head2 deploy + +See L. + =head2 version_storage_is_installed - warn q(I can't version this database!) - unless $dh->version_storage_is_installed +See L. -return true iff the version storage is installed. +=head2 add_database_version -=head2 deploy +See L. - $dh->deploy +=head2 delete_database_version -Deploy the schema to the database. +See L. -=head2 add_database_version +=head2 next_version_set - $dh->add_database_version({ - version => '1.02', - ddl => $ddl # can be undef, - upgrade_sql => $sql # can be undef, - }); +See L. -Store a new version into the version storage +=head2 previous_version_set -=head2 delete_database_version +See L. - $dh->delete_database_version({ version => '1.02' }) +=head2 upgrade_single_step -simply deletes given database version from the version storage +See L. -=head2 next_version_set +=head2 downgrade_single_step - print 'versions to install: '; - while (my $vs = $dh->next_version_set) { - print join q(, ), @{$vs} - } - print qq(\n); +See L. -return an arrayref describing each version that needs to be -installed to upgrade to C<< $dh->to_version >>. +=head2 txn_do -=head2 previous_version_set +See L. - print 'versions to uninstall: '; - while (my $vs = $dh->previous_version_set) { - print join q(, ), @{$vs} - } - print qq(\n); +=head1 ORTHODOX METHODS -return an arrayref describing each version that needs to be -"installed" to downgrade to C<< $dh->to_version >>. +These methods are not actually B as things will probably still work +if you don't implement them, but if you want your subclass to get along with +other subclasses (or more likely, tools made to use another subclass), you +should probably implement these too, even if they are no-ops. -=head2 upgrade_single_step +=head2 database_version - my ($ddl, $sql) = @{$dh->upgrade_single_step($version_set)||[]} +see L -call a single upgrade migration. Takes an arrayref describing the version to -upgrade to. Optionally return an arrayref containing C<$ddl> describing -version installed and C<$sql> used to get to that version. +=head2 prepare_deploy -=head2 downgrade_single_step +see L - $dh->upgrade_single_step($version_set); +=head2 prepare_resultsource_install -call a single downgrade migration. Takes an arrayref describing the version to -downgrade to. +see L -__END__ +=head2 install_resultsource + +see L + +=head2 prepare_upgrade + +see L + +=head2 prepare_downgrade + +see L + +=head2 SUBCLASSING + +All of the methods mentioned in L and +L can be implemented in any fashion you choose. In the +spirit of code reuse I have used roles to implement them in my two subclasses, +L and +L, but you are free to implement +them entirely in a subclass if you so choose to. + +For in-depth documentation on how methods are supposed to work, see the roles +L, +L, and +L. -vim: ts=2 sw=2 expandtab