From: Nigel Metheringham Date: Thu, 14 Jan 2010 15:52:50 +0000 (+0000) Subject: Changes to support multiple step schema version updates X-Git-Tag: v0.08116~31^2~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d2bc7045e78e5bc547e32133e48d2f994d158491;p=dbsrgits%2FDBIx-Class.git Changes to support multiple step schema version updates --- diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index e6af6e0..c7a89d7 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -181,7 +181,7 @@ use warnings; use base 'DBIx::Class::Schema'; use Carp::Clan qw/^DBIx::Class/; -use POSIX 'strftime'; +use Time::HiRes qw/gettimeofday/; __PACKAGE__->mk_classdata('_filedata'); __PACKAGE__->mk_classdata('upgrade_directory'); @@ -271,32 +271,129 @@ sub create_upgrade_path { ## override this method } +=head2 ordered_schema_versions + +=over 4 + +=item Returns: a list of version numbers, ordered from lowest to highest + +=back + +Virtual method that should be overriden to return an ordered list +of schema versions. This is then used to produce a set of steps to +upgrade through to achieve the required schema version. + +You may want the db_version retrieved via $self->get_db_version +and the schema_version which is retrieved via $self->schema_version + +=cut + +sub ordered_schema_versions { + ## override this method +} + =head2 upgrade -Call this to attempt to upgrade your database from the version it is at to the version -this DBIC schema is at. If they are the same it does nothing. +Call this to attempt to upgrade your database from the version it +is at to the version this DBIC schema is at. If they are the same +it does nothing. -It requires an SQL diff file to exist in you I, normally you will -have created this using L. +It will call L to retrieve an ordered +list of schema versions (if ordered_schema_versions returns nothing +then it is assumed you can do the upgrade as a single step). It +then iterates through the list of versions between the current db +version and the schema version applying one update at a time until +all relvant updates are applied. -If successful the dbix_class_schema_versions table is updated with the current -DBIC schema version. +The individual update steps are performed by using +L, which will apply the update and also +update the dbix_class_schema_versions table. =cut -sub upgrade -{ - my ($self) = @_; - my $db_version = $self->get_db_version(); +sub upgrade { + my ($self) = @_; + my $db_version = $self->get_db_version(); - # db unversioned - unless ($db_version) { - carp 'Upgrade not possible as database is unversioned. Please call install first.'; - return; - } + # db unversioned + unless ($db_version) { + carp 'Upgrade not possible as database is unversioned. Please call install first.'; + return; + } + + # db and schema at same version. do nothing + if ( $db_version eq $self->schema_version ) { + carp "Upgrade not necessary\n"; + return; + } + + my @version_list = $self->ordered_schema_versions; + + # if nothing returned then we preload with min/max + @version_list = ( $db_version, $self->schema_version ) + unless ( scalar(@version_list) ); + + # catch the case of someone returning an arrayref + @version_list = @{ $version_list[0] } + if ( ref( $version_list[0] ) eq 'ARRAY' ); + + # remove all versions in list above the required version + while ( scalar(@version_list) + && ( $version_list[-1] ne $self->schema_version ) ) + { + pop @version_list; + } + + # remove all versions in list below the current version + while ( scalar(@version_list) && ( $version_list[0] ne $db_version ) ) { + shift @version_list; + } + + # check we have an appropriate list of versions + if ( scalar(@version_list) < 2 ) { + die; + } + + # do sets of upgrade + while ( scalar(@version_list) >= 2 ) { + $self->upgrade_single_step( $version_list[0], $version_list[1] ); + shift @version_list; + } +} + +=head2 upgrade_single_step + +=over 4 + +=item Arguments: db_version - the version currently within the db + +=item Arguments: target_version - the version to upgrade to + +=back + +Call this to attempt to upgrade your database from the +I to the I. If they are the same it +does nothing. + +It requires an SQL diff file to exist in your I, +normally you will have created this using L. + +If successful the dbix_class_schema_versions table is updated with +the I. + +This method may be called repeatedly by the upgrade method to +upgrade through a series of updates. + +=cut + +sub upgrade_single_step +{ + my ($self, + $db_version, + $target_version) = @_; # db and schema at same version. do nothing - if ($db_version eq $self->schema_version) { + if ($db_version eq $target_version) { carp "Upgrade not necessary\n"; return; } @@ -309,7 +406,7 @@ sub upgrade my $upgrade_file = $self->ddl_filename( $self->storage->sqlt_type, - $self->schema_version, + $target_version, $self->upgrade_directory, $db_version, ); @@ -329,7 +426,7 @@ sub upgrade $self->txn_do(sub { $self->do_upgrade() }); # set row in dbix_class_schema_versions table - $self->_set_db_version; + $self->_set_db_version({version => $target_version}); } =head2 do_upgrade @@ -574,10 +671,33 @@ sub _set_db_version { my $version = $params->{version} ? $params->{version} : $self->schema_version; my $vtable = $self->{vschema}->resultset('Table'); - $vtable->create({ version => $version, - installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) - }); + ############################################################################## + # !!! NOTE !!! + ############################################################################## + # + # The travesty below replaces the old nice timestamp format of %Y-%m-%d %H:%M:%S + # This is necessary since there are legitimate cases when upgrades can happen + # back to back within the same second. This breaks things since we relay on the + # ability to sort by the 'installed' value. The logical choice of an autoinc + # is not possible, as it will break multiple legacy installations. Also it is + # not possible to format the string sanely, as the column is a varchar(20). + # The 'v' character is added to the front of the string, so that any version + # formatted by this new function will sort _after_ any existing 200... strings. + my @tm = gettimeofday(); + my @dt = gmtime ($tm[0]); + my $o = $vtable->create({ + version => $version, + installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f", + $dt[5] + 1900, + $dt[4] + 1, + $dt[3], + $dt[2], + $dt[1], + $dt[0], + $tm[1] / 1000, # convert to millisecs, format as up/down rounded int above + ), + }); } sub _read_sql_file { diff --git a/t/94versioning.t b/t/94versioning.t index 674a855..4d3c780 100644 --- a/t/94versioning.t +++ b/t/94versioning.t @@ -32,56 +32,56 @@ my $ddl_dir = File::Spec->catdir ('t', 'var'); my $fn = { v1 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-1.0-MySQL.sql'), v2 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-2.0-MySQL.sql'), - trans => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-1.0-2.0-MySQL.sql'), + v3 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-3.0-MySQL.sql'), + trans_v12 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-1.0-2.0-MySQL.sql'), + trans_v23 => File::Spec->catfile($ddl_dir, 'DBICVersion-Schema-2.0-3.0-MySQL.sql'), }; use lib qw(t/lib); use DBICTest; # do not remove even though it is not used -use_ok('DBICVersionOrig'); +use_ok('DBICVersion_v1'); -my $schema_orig = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); -eval { $schema_orig->storage->dbh->do('drop table ' . $version_table_name) }; -eval { $schema_orig->storage->dbh->do('drop table ' . $old_table_name) }; +my $schema_v1 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); +eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) }; +eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) }; -is($schema_orig->ddl_filename('MySQL', '1.0', $ddl_dir), $fn->{v1}, 'Filename creation working'); +is($schema_v1->ddl_filename('MySQL', '1.0', $ddl_dir), $fn->{v1}, 'Filename creation working'); unlink( $fn->{v1} ) if ( -e $fn->{v1} ); -$schema_orig->create_ddl_dir('MySQL', undef, $ddl_dir); +$schema_v1->create_ddl_dir('MySQL', undef, $ddl_dir); ok(-f $fn->{v1}, 'Created DDL file'); -$schema_orig->deploy({ add_drop_table => 1 }); +$schema_v1->deploy({ add_drop_table => 1 }); -my $tvrs = $schema_orig->{vschema}->resultset('Table'); -is($schema_orig->_source_exists($tvrs), 1, 'Created schema from DDL file'); +my $tvrs = $schema_v1->{vschema}->resultset('Table'); +is($schema_v1->_source_exists($tvrs), 1, 'Created schema from DDL file'); # loading a new module defining a new version of the same table DBICVersion::Schema->_unregister_source ('Table'); -eval "use DBICVersionNew"; +eval "use DBICVersion_v2"; -my $schema_upgrade = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); +my $schema_v2 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); { unlink($fn->{v2}); - unlink($fn->{trans}); + unlink($fn->{trans_v12}); - is($schema_upgrade->get_db_version(), '1.0', 'get_db_version ok'); - is($schema_upgrade->schema_version, '2.0', 'schema version ok'); - $schema_upgrade->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0'); - ok(-f $fn->{trans}, 'Created DDL file'); + is($schema_v2->get_db_version(), '1.0', 'get_db_version ok'); + is($schema_v2->schema_version, '2.0', 'schema version ok'); + $schema_v2->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0'); + ok(-f $fn->{trans_v12}, 'Created DDL file'); { my $w; local $SIG{__WARN__} = sub { $w = shift }; - sleep 1; # remove this when TODO below is completed - - $schema_upgrade->upgrade(); + $schema_v2->upgrade(); like ($w, qr/Attempting upgrade\.$/, 'Warn before upgrade'); } - is($schema_upgrade->get_db_version(), '2.0', 'db version number upgraded'); + is($schema_v2->get_db_version(), '2.0', 'db version number upgraded'); eval { - $schema_upgrade->storage->dbh->do('select NewVersionName from TestVersion'); + $schema_v2->storage->dbh->do('select NewVersionName from TestVersion'); }; is($@, '', 'new column created'); @@ -95,11 +95,11 @@ my $schema_upgrade = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_v warn @_; } }; - $schema_upgrade->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0'); + $schema_v2->create_ddl_dir('MySQL', '2.0', $ddl_dir, '1.0'); is (2, @w, 'A warning generated for both the DDL and the diff'); like ($w[0], qr/Overwriting existing DDL file - $fn->{v2}/, 'New version DDL overwrite warning'); - like ($w[1], qr/Overwriting existing diff file - $fn->{trans}/, 'Upgrade diff overwrite warning'); + like ($w[1], qr/Overwriting existing diff file - $fn->{trans_v12}/, 'Upgrade diff overwrite warning'); } { @@ -125,6 +125,63 @@ my $schema_upgrade = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_v } +# repeat the v1->v2 process for v2->v3 before testing v1->v3 +DBICVersion::Schema->_unregister_source ('Table'); +eval "use DBICVersion_v3"; + +my $schema_v3 = DBICVersion::Schema->connect($dsn, $user, $pass, { ignore_version => 1 }); +{ + unlink($fn->{v3}); + unlink($fn->{trans_v23}); + + is($schema_v3->get_db_version(), '2.0', 'get_db_version 2.0 ok'); + is($schema_v3->schema_version, '3.0', 'schema version 3.0 ok'); + $schema_v3->create_ddl_dir('MySQL', '3.0', $ddl_dir, '2.0'); + ok(-f $fn->{trans_v23}, 'Created DDL 2.0 -> 3.0 file'); + + { + my $w; + local $SIG{__WARN__} = sub { $w = shift }; + + $schema_v3->upgrade(); + like ($w, qr/Attempting upgrade\.$/, 'Warn before upgrade'); + } + + is($schema_v3->get_db_version(), '3.0', 'db version number upgraded'); + + eval { + $schema_v3->storage->dbh->do('select ExtraColumn from TestVersion'); + }; + is($@, '', 'new column created'); +} + +# now put the v1 schema back again +{ + # drop all the tables... + eval { $schema_v1->storage->dbh->do('drop table ' . $version_table_name) }; + eval { $schema_v1->storage->dbh->do('drop table ' . $old_table_name) }; + eval { $schema_v1->storage->dbh->do('drop table TestVersion') }; + + { + local $DBICVersion::Schema::VERSION = '1.0'; + $schema_v1->deploy; + } + is($schema_v1->get_db_version(), '1.0', 'get_db_version 1.0 ok'); +} + +# attempt v1 -> v3 upgrade.... +{ + { + my $w; + local $SIG{__WARN__} = sub { $w = shift }; + + $schema_v3->upgrade(); + like ($w, qr/Attempting upgrade\.$/, 'Warn before upgrade'); + } + + is($schema_v3->get_db_version(), '3.0', 'db version number upgraded'); +} + # check behaviour of DBIC_NO_VERSION_CHECK env var and ignore_version connect attr { my $schema_version = DBICVersion::Schema->connect($dsn, $user, $pass); @@ -162,9 +219,9 @@ TODO: { local $TODO = 'To fix this properly the table must be extended with an autoinc column, mst will not accept anything less'; - eval { $schema_orig->storage->dbh->do('drop table ' . $version_table_name) }; - eval { $schema_orig->storage->dbh->do('drop table ' . $old_table_name) }; - eval { $schema_orig->storage->dbh->do('drop table TestVersion') }; + eval { $schema_v2->storage->dbh->do('drop table ' . $version_table_name) }; + eval { $schema_v2->storage->dbh->do('drop table ' . $old_table_name) }; + eval { $schema_v2->storage->dbh->do('drop table TestVersion') }; # this attempts to sleep until the turn of the second my $t = time(); @@ -172,14 +229,14 @@ TODO: { diag ('Fast deploy/upgrade start: ', time() ); { - local $DBICVersion::Schema::VERSION = '1.0'; - $schema_orig->deploy; + local $DBICVersion::Schema::VERSION = '2.0'; + $schema_v2->deploy; } local $SIG{__WARN__} = sub { warn if $_[0] !~ /Attempting upgrade\.$/ }; - $schema_upgrade->upgrade(); + $schema_v2->upgrade(); - is($schema_upgrade->get_db_version(), '2.0', 'Fast deploy/upgrade'); + is($schema_v2->get_db_version(), '3.0', 'Fast deploy/upgrade'); }; unless ($ENV{DBICTEST_KEEP_VERSIONING_DDL}) { diff --git a/t/lib/DBICVersionOrig.pm b/t/lib/DBICVersion_v1.pm similarity index 93% rename from t/lib/DBICVersionOrig.pm rename to t/lib/DBICVersion_v1.pm index 3bdc0e2..56c01e2 100644 --- a/t/lib/DBICVersionOrig.pm +++ b/t/lib/DBICVersion_v1.pm @@ -42,4 +42,8 @@ sub upgrade_directory return 't/var/'; } +sub ordered_schema_versions { + return('1.0','2.0','3.0'); +} + 1; diff --git a/t/lib/DBICVersionNew.pm b/t/lib/DBICVersion_v2.pm similarity index 100% copy from t/lib/DBICVersionNew.pm copy to t/lib/DBICVersion_v2.pm diff --git a/t/lib/DBICVersionNew.pm b/t/lib/DBICVersion_v3.pm similarity index 82% rename from t/lib/DBICVersionNew.pm rename to t/lib/DBICVersion_v3.pm index b6508ca..29caaae 100644 --- a/t/lib/DBICVersionNew.pm +++ b/t/lib/DBICVersion_v3.pm @@ -30,6 +30,14 @@ __PACKAGE__->add_columns 'is_foreign_key' => 0, 'is_nullable' => 1, 'size' => '20' + }, + 'ExtraColumn' => { + 'data_type' => 'VARCHAR', + 'is_auto_increment' => 0, + 'default_value' => undef, + 'is_foreign_key' => 0, + 'is_nullable' => 1, + 'size' => '20' } ); @@ -40,16 +48,11 @@ use base 'DBIx::Class::Schema'; use strict; use warnings; -our $VERSION = '2.0'; +our $VERSION = '3.0'; __PACKAGE__->register_class('Table', 'DBICVersion::Table'); __PACKAGE__->load_components('+DBIx::Class::Schema::Versioned'); __PACKAGE__->upgrade_directory('t/var/'); __PACKAGE__->backup_directory('t/var/backup/'); -#sub upgrade_directory -#{ -# return 't/var/'; -#} - 1;