X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FVersioned.pm;h=929e79b2630e6b3426739239e3f43a817287d482;hb=d40a22fc4ecf7000051b91ffe3fee318f4e85cb4;hp=4e92def8abb4fe734fd512fbe05fb3f1033ca096;hpb=341d5edefa34c7cdfee74be00eba9cd44ad2b7c4;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm
index 4e92def..929e79b 100644
--- a/lib/DBIx/Class/Schema/Versioned.pm
+++ b/lib/DBIx/Class/Schema/Versioned.pm
@@ -1,10 +1,9 @@
 package # Hide from PAUSE
   DBIx::Class::Version::Table;
-use base 'DBIx::Class';
+use base 'DBIx::Class::Core';
 use strict;
 use warnings;
 
-__PACKAGE__->load_components(qw/ Core/);
 __PACKAGE__->table('dbix_class_schema_versions');
 
 __PACKAGE__->add_columns
@@ -31,8 +30,7 @@ __PACKAGE__->set_primary_key('version');
 
 package # Hide from PAUSE
   DBIx::Class::Version::TableCompat;
-use base 'DBIx::Class';
-__PACKAGE__->load_components(qw/ Core/);
+use base 'DBIx::Class::Core';
 __PACKAGE__->table('SchemaVersions');
 
 __PACKAGE__->add_columns
@@ -70,12 +68,12 @@ DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades
 
 =head1 SYNOPSIS
 
-  package Library::Schema;
+  package MyApp::Schema;
   use base qw/DBIx::Class::Schema/;
 
   our $VERSION = 0.001;
 
-  # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
+  # load MyApp::Schema::CD, MyApp::Schema::Book, MyApp::Schema::DVD
   __PACKAGE__->load_classes(qw/CD Book DVD/);
 
   __PACKAGE__->load_components(qw/Schema::Versioned/);
@@ -180,10 +178,10 @@ package DBIx::Class::Schema::Versioned;
 
 use strict;
 use warnings;
-use base 'DBIx::Class';
+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');
@@ -270,35 +268,132 @@ and the schema_version which is retrieved via $self->schema_version
 =cut
 
 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<upgrade_directory>, normally you will
-have created this using L<DBIx::Class::Schema/create_ddl_dir>.
+It will call L</ordered_schema_versions> 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</upgrade_single_step>, 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<db_version> to the I<target_version>. If they are the same it
+does nothing.
+
+It requires an SQL diff file to exist in your I<upgrade_directory>,
+normally you will have created this using L<DBIx::Class::Schema/create_ddl_dir>.
+
+If successful the dbix_class_schema_versions table is updated with
+the I<target_version>.
+
+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;
   }
@@ -308,10 +403,10 @@ sub upgrade
   # here to be sure.
   # XXX - just fix it
   $self->storage->sqlt_type;
-  
+
   my $upgrade_file = $self->ddl_filename(
                                          $self->storage->sqlt_type,
-                                         $self->schema_version,
+                                         $target_version,
                                          $self->upgrade_directory,
                                          $db_version,
                                         );
@@ -323,7 +418,7 @@ sub upgrade
     return;
   }
 
-  carp "\nDB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
+  carp "DB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
 
   # backup if necessary then apply upgrade
   $self->_filedata($self->_read_sql_file($upgrade_file));
@@ -331,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
@@ -393,7 +488,7 @@ differently.
 sub apply_statement {
     my ($self, $statement) = @_;
 
-    $self->storage->dbh->do($_) or carp "SQL was:\n $_";
+    $self->storage->dbh->do($_) or carp "SQL was: $_";
 }
 
 =head2 get_db_version
@@ -472,9 +567,13 @@ sub _on_connect
   my ($self, $args) = @_;
 
   $args = {} unless $args;
+
   $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
   my $vtable = $self->{vschema}->resultset('Table');
 
+  # useful when connecting from scripts etc
+  return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
+
   # check for legacy versions table and move to new if exists
   my $vschema_compat = DBIx::Class::VersionCompat->connect(@{$self->storage->connect_info()});
   unless ($self->_source_exists($vtable)) {
@@ -486,8 +585,6 @@ sub _on_connect
     }
   }
 
-  # useful when connecting from scripts etc
-  return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
   my $pversion = $self->get_db_version();
 
   if($pversion eq $self->schema_version)
@@ -502,7 +599,7 @@ sub _on_connect
         return 1;
     }
 
-  carp "Versions out of sync. This is " . $self->schema_version . 
+  carp "Versions out of sync. This is " . $self->schema_version .
     ", your database contains version $pversion, please call upgrade on your Schema.\n";
 }
 
@@ -520,13 +617,11 @@ sub _create_db_to_schema_diff {
     return;
   }
 
-  eval 'require SQL::Translator "0.09003"';
-  if ($@) {
-    $self->throw_exception("SQL::Translator 0.09003 required");
-  }
+  $self->throw_exception($self->storage->_sqlt_version_error)
+    if (not $self->storage->_sqlt_version_ok);
 
-  my $db_tr = SQL::Translator->new({ 
-                                    add_drop_table => 1, 
+  my $db_tr = SQL::Translator->new({
+                                    add_drop_table => 1,
                                     parser => 'DBI',
                                     parser_args => { dbh => $self->storage->dbh }
                                    });
@@ -576,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 {