From: Arthur Axel 'fREW' Schmidt <frioux@gmail.com>
Date: Mon, 29 Mar 2010 02:55:24 +0000 (-0500)
Subject: monotonic is recommended; fix tests to use it etc
X-Git-Tag: v0.001000_01~29
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-DeploymentHandler.git;a=commitdiff_plain;h=4a65f60b80222596f851950728f0a115f511481c

monotonic is recommended; fix tests to use it etc
---

diff --git a/lib/DBIx/Class/DeploymentHandler.pm b/lib/DBIx/Class/DeploymentHandler.pm
index 3524615..093ea62 100644
--- a/lib/DBIx/Class/DeploymentHandler.pm
+++ b/lib/DBIx/Class/DeploymentHandler.pm
@@ -6,7 +6,7 @@ extends 'DBIx::Class::DeploymentHandler::Dad';
 # a single with would be better, but we can't do that
 # see: http://rt.cpan.org/Public/Bug/Display.html?id=46347
 with 'DBIx::Class::DeploymentHandler::WithSqltDeployMethod',
-     'DBIx::Class::DeploymentHandler::WithDatabaseToSchemaVersions',
+     'DBIx::Class::DeploymentHandler::WithMonotonicVersions',
      'DBIx::Class::DeploymentHandler::WithStandardVersionStorage';
 with 'DBIx::Class::DeploymentHandler::WithReasonableDefaults';
 
diff --git a/lib/DBIx/Class/DeploymentHandler/WithMonotonicVersions.pm b/lib/DBIx/Class/DeploymentHandler/WithMonotonicVersions.pm
new file mode 100644
index 0000000..c62dabf
--- /dev/null
+++ b/lib/DBIx/Class/DeploymentHandler/WithMonotonicVersions.pm
@@ -0,0 +1,29 @@
+package DBIx::Class::DeploymentHandler::WithMonotonicVersions;
+use Moose::Role;
+
+use DBIx::Class::DeploymentHandler::VersionHandler::Monotonic;
+
+has version_handler => (
+  is         => 'ro',
+  lazy_build => 1,
+  does       => 'DBIx::Class::DeploymentHandler::HandlesVersioning',
+  handles    => 'DBIx::Class::DeploymentHandler::HandlesVersioning',
+);
+
+sub _build_version_handler {
+  my $self = shift;
+
+  my $args = {
+    database_version => $self->database_version,
+    schema_version   => $self->schema_version,
+  };
+
+  $args->{to_version} = $self->to_version if $self->has_to_version;
+  DBIx::Class::DeploymentHandler::VersionHandler::Monotonic->new($args);
+}
+
+1;
+
+__END__
+
+vim: ts=2 sw=2 expandtab
diff --git a/lib/DBIx/Class/DeploymentHandler/WithReasonableDefaults.pm b/lib/DBIx/Class/DeploymentHandler/WithReasonableDefaults.pm
index 56997df..74c937b 100644
--- a/lib/DBIx/Class/DeploymentHandler/WithReasonableDefaults.pm
+++ b/lib/DBIx/Class/DeploymentHandler/WithReasonableDefaults.pm
@@ -3,7 +3,7 @@ use Moose::Role;
 
 requires qw( prepare_upgrade prepare_downgrade database_version schema_version );
 
-around qw( prepare_upgrade prepare_downgrade ) => sub {
+around prepare_upgrade => sub {
   my $orig = shift;
   my $self = shift;
 
@@ -15,6 +15,18 @@ around qw( prepare_upgrade prepare_downgrade ) => sub {
 };
 
 
+around prepare_downgrade => sub {
+  my $orig = shift;
+  my $self = shift;
+
+  my $from_version = shift || $self->database_version;
+  my $to_version   = shift || $self->schema_version;
+  my $version_set  = shift || [$to_version, $from_version];
+
+  $self->$orig($from_version, $to_version, $version_set);
+};
+
+
 1;
 
 __END__
diff --git a/t/02-instantiation.t b/t/02-instantiation.t
index 29fb08d..b302e98 100644
--- a/t/02-instantiation.t
+++ b/t/02-instantiation.t
@@ -1,10 +1,162 @@
 #!perl
 
+use strict;
+use warnings;
+
 use lib 't/lib';
 use DBICDHTest;
 use DBIx::Class::DeploymentHandler;
+use aliased 'DBIx::Class::DeploymentHandler', 'DH';
+
+use File::Path 'remove_tree';
 use Test::More;
+use Test::Exception;
+
+DBICDHTest::ready;
+
+my $db = 'dbi:SQLite:db.db';
+my @connection = ($db, '', '', { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+VERSION1: {
+  use_ok 'DBICVersion_v1';
+  my $s = DBICVersion::Schema->connect(@connection);
+  $DBICVersion::Schema::VERSION = 1;
+  ok($s, 'DBICVersion::Schema 1 instantiates correctly');
+  my $handler = DH->new({
+    upgrade_directory => $sql_dir,
+    schema => $s,
+    databases => 'SQLite',
+    sqltargs => { add_drop_table => 0 },
+  });
+
+  ok($handler, 'DBIx::Class::DeploymentHandler w/1 instantiates correctly');
+
+  my $version = $s->schema_version;
+  $handler->prepare_install;
+
+  dies_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+    })
+  } 'schema not deployed';
+  $handler->install;
+  dies_ok {
+    $handler->install;
+  } 'cannot install twice';
+  lives_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+    })
+  } 'schema is deployed';
+}
+
+VERSION2: {
+  use_ok 'DBICVersion_v2';
+  my $s = DBICVersion::Schema->connect(@connection);
+  $DBICVersion::Schema::VERSION = 2;
+  ok($s, 'DBICVersion::Schema 2 instantiates correctly');
+  my $handler = DH->new({
+    upgrade_directory => $sql_dir,
+    schema => $s,
+    databases => 'SQLite',
+  });
+
+  ok($handler, 'DBIx::Class::DeploymentHandler w/2 instantiates correctly');
+
+  my $version = $s->schema_version();
+  $handler->prepare_install();
+  $handler->prepare_upgrade(1, $version);
+  dies_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+      baz => 'frew',
+    })
+  } 'schema not deployed';
+  dies_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+      baz => 'frew',
+    })
+  } 'schema not uppgrayyed';
+  $handler->upgrade;
+  lives_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+      baz => 'frew',
+    })
+  } 'schema is deployed';
+}
+
+VERSION3: {
+  use_ok 'DBICVersion_v3';
+  my $s = DBICVersion::Schema->connect(@connection);
+  $DBICVersion::Schema::VERSION = 3;
+  ok($s, 'DBICVersion::Schema 3 instantiates correctly');
+  my $handler = DH->new({
+    upgrade_directory => $sql_dir,
+    schema => $s,
+    databases => 'SQLite',
+  });
+
+  ok($handler, 'DBIx::Class::DeploymentHandler w/3 instantiates correctly');
+
+  my $version = $s->schema_version();
+  $handler->prepare_install;
+  $handler->prepare_upgrade( 2, $version );
+  dies_ok {
+    $s->resultset('Foo')->create({
+        bar => 'frew',
+        baz => 'frew',
+        biff => 'frew',
+      })
+  } 'schema not deployed';
+  $handler->upgrade;
+  lives_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+      baz => 'frew',
+      biff => 'frew',
+    })
+  } 'schema is deployed';
+}
+
+DOWN2: {
+  use_ok 'DBICVersion_v4';
+  my $s = DBICVersion::Schema->connect(@connection);
+  $DBICVersion::Schema::VERSION = 2;
+  ok($s, 'DBICVersion::Schema 2 instantiates correctly');
+  my $handler = DH->new({
+    upgrade_directory => $sql_dir,
+    schema => $s,
+    databases => 'SQLite',
+  });
+
+  ok($handler, 'DBIx::Class::DeploymentHandler w/2 instantiates correctly');
 
-DBICDHTest::test_bundle(DBIx::Class::DeploymentHandler);
+  my $version = $s->schema_version();
+  $handler->prepare_downgrade(3, $version);
+  lives_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+      baz => 'frew',
+      biff => 'frew',
+    })
+  } 'schema at version 3';
+  $handler->downgrade;
+  dies_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+      baz => 'frew',
+      biff => 'frew',
+    })
+  } 'schema not at version 3';
+  lives_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+      baz => 'frew',
+    })
+  } 'schema is at version 2';
+}
 
 done_testing;
diff --git a/t/03-deprecated.t b/t/03-deprecated.t
index f69f2e9..288299f 100644
--- a/t/03-deprecated.t
+++ b/t/03-deprecated.t
@@ -2,9 +2,121 @@
 
 use lib 't/lib';
 use DBICDHTest;
-use DBIx::Class::DeploymentHandler::Deprecated;
+use aliased 'DBIx::Class::DeploymentHandler::Deprecated';
+
+use File::Path 'remove_tree';
 use Test::More;
+use Test::Exception;
+
+DBICDHTest::ready;
+
+my $db = 'dbi:SQLite:db.db';
+my @connection = ($db, '', '', { ignore_version => 1 });
+my $sql_dir = 't/sql';
+
+ready;
+
+VERSION1: {
+  use_ok 'DBICVersion_v1';
+  my $s = DBICVersion::Schema->connect(@connection);
+  is $s->schema_version, '1.0', 'schema version is at 1.0';
+  ok($s, 'DBICVersion::Schema 1.0 instantiates correctly');
+  my $handler = Deprecated->new({
+    upgrade_directory => $sql_dir,
+    schema => $s,
+    databases => 'SQLite',
+    sqltargs => { add_drop_table => 0 },
+  });
+
+  ok($handler, 'DBIx::Class::DeploymentHandler w/1.0 instantiates correctly');
+
+  my $version = $s->schema_version();
+  $handler->prepare_install();
+
+  dies_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+    })
+  } 'schema not deployed';
+  $handler->install;
+  dies_ok {
+    $handler->install;
+  } 'cannot install twice';
+  lives_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+    })
+  } 'schema is deployed';
+}
+
+VERSION2: {
+  use_ok 'DBICVersion_v2';
+  my $s = DBICVersion::Schema->connect(@connection);
+  is $s->schema_version, '2.0', 'schema version is at 2.0';
+  ok($s, 'DBICVersion::Schema 2.0 instantiates correctly');
+  my $handler = Deprecated->new({
+    upgrade_directory => $sql_dir,
+    schema => $s,
+    databases => 'SQLite',
+  });
+
+  ok($handler, 'DBIx::Class::DeploymentHandler w/2.0 instantiates correctly');
+
+  my $version = $s->schema_version();
+  $handler->prepare_install();
+  $handler->prepare_upgrade('1.0', $version);
+  dies_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+      baz => 'frew',
+    })
+  } 'schema not deployed';
+  dies_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+      baz => 'frew',
+    })
+  } 'schema not uppgrayyed';
+  $handler->upgrade;
+  lives_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+      baz => 'frew',
+    })
+  } 'schema is deployed';
+}
+
+VERSION3: {
+  use_ok 'DBICVersion_v3';
+  my $s = DBICVersion::Schema->connect(@connection);
+  is $s->schema_version, '3.0', 'schema version is at 3.0';
+  ok($s, 'DBICVersion::Schema 3.0 instantiates correctly');
+  my $handler = Deprecated->new({
+    upgrade_directory => $sql_dir,
+    schema => $s,
+    databases => 'SQLite',
+  });
+
+  ok($handler, 'DBIx::Class::DeploymentHandler w/3.0 instantiates correctly');
 
-DBICDHTest::test_bundle(DBIx::Class::DeploymentHandler::Deprecated);
+  my $version = $s->schema_version();
+  $handler->prepare_install;
+  $handler->prepare_upgrade( '2.0', $version );
+  dies_ok {
+    $s->resultset('Foo')->create({
+        bar => 'frew',
+        baz => 'frew',
+        biff => 'frew',
+      })
+  } 'schema not deployed';
+  $handler->upgrade;
+  lives_ok {
+    $s->resultset('Foo')->create({
+      bar => 'frew',
+      baz => 'frew',
+      biff => 'frew',
+    })
+  } 'schema is deployed';
+}
 
 done_testing;
diff --git a/t/lib/DBICDHTest.pm b/t/lib/DBICDHTest.pm
index 908b767..7960e05 100644
--- a/t/lib/DBICDHTest.pm
+++ b/t/lib/DBICDHTest.pm
@@ -15,155 +15,4 @@ sub ready {
    }
 }
 
-sub test_bundle {
-	my $bundle = shift;
-	my $db = 'dbi:SQLite:db.db';
-	my @connection = ($db, '', '', { ignore_version => 1 });
-	my $sql_dir = 't/sql';
-
-	ready;
-
-	VERSION1: {
-		use_ok 'DBICVersion_v1';
-		my $s = DBICVersion::Schema->connect(@connection);
-		is $s->schema_version, '1.0', 'schema version is at 1.0';
-		ok($s, 'DBICVersion::Schema 1.0 instantiates correctly');
-		my $handler = $bundle->new({
-			upgrade_directory => $sql_dir,
-			schema => $s,
-			databases => 'SQLite',
-			sqltargs => { add_drop_table => 0 },
-		});
-
-		ok($handler, 'DBIx::Class::DeploymentHandler w/1.0 instantiates correctly');
-
-		my $version = $s->schema_version();
-		$handler->prepare_install();
-
-		dies_ok {
-			$s->resultset('Foo')->create({
-				bar => 'frew',
-			})
-		} 'schema not deployed';
-		$handler->install;
-		dies_ok {
-		  $handler->install;
-		} 'cannot install twice';
-		lives_ok {
-			$s->resultset('Foo')->create({
-				bar => 'frew',
-			})
-		} 'schema is deployed';
-	}
-
-	VERSION2: {
-		use_ok 'DBICVersion_v2';
-		my $s = DBICVersion::Schema->connect(@connection);
-		is $s->schema_version, '2.0', 'schema version is at 2.0';
-		ok($s, 'DBICVersion::Schema 2.0 instantiates correctly');
-		my $handler = $bundle->new({
-			upgrade_directory => $sql_dir,
-			schema => $s,
-			databases => 'SQLite',
-		});
-
-		ok($handler, 'DBIx::Class::DeploymentHandler w/2.0 instantiates correctly');
-
-		my $version = $s->schema_version();
-		$handler->prepare_install();
-		$handler->prepare_upgrade('1.0', $version);
-		dies_ok {
-			$s->resultset('Foo')->create({
-				bar => 'frew',
-				baz => 'frew',
-			})
-		} 'schema not deployed';
-		dies_ok {
-			$s->resultset('Foo')->create({
-				bar => 'frew',
-				baz => 'frew',
-			})
-		} 'schema not uppgrayyed';
-		$handler->upgrade;
-		lives_ok {
-			$s->resultset('Foo')->create({
-				bar => 'frew',
-				baz => 'frew',
-			})
-		} 'schema is deployed';
-	}
-
-	VERSION3: {
-		use_ok 'DBICVersion_v3';
-		my $s = DBICVersion::Schema->connect(@connection);
-		is $s->schema_version, '3.0', 'schema version is at 3.0';
-		ok($s, 'DBICVersion::Schema 3.0 instantiates correctly');
-		my $handler = $bundle->new({
-			upgrade_directory => $sql_dir,
-			schema => $s,
-			databases => 'SQLite',
-		});
-
-		ok($handler, 'DBIx::Class::DeploymentHandler w/3.0 instantiates correctly');
-
-		my $version = $s->schema_version();
-		$handler->prepare_install;
-		$handler->prepare_upgrade( '2.0', $version );
-		dies_ok {
-			$s->resultset('Foo')->create({
-					bar => 'frew',
-					baz => 'frew',
-					biff => 'frew',
-				})
-		} 'schema not deployed';
-		$handler->upgrade;
-		lives_ok {
-			$s->resultset('Foo')->create({
-				bar => 'frew',
-				baz => 'frew',
-				biff => 'frew',
-			})
-		} 'schema is deployed';
-	}
-
-	DOWN2: {
-		use_ok 'DBICVersion_v4';
-		my $s = DBICVersion::Schema->connect(@connection);
-		is $s->schema_version, '2.0', 'schema version is at 2.0';
-		ok($s, 'DBICVersion::Schema 2.0 instantiates correctly');
-		my $handler = $bundle->new({
-			upgrade_directory => $sql_dir,
-			schema => $s,
-			databases => 'SQLite',
-		});
-
-		ok($handler, 'DBIx::Class::DeploymentHandler w/2.0 instantiates correctly');
-
-		my $version = $s->schema_version();
-		$handler->prepare_downgrade('3.0', $version);
-		lives_ok {
-			$s->resultset('Foo')->create({
-				bar => 'frew',
-				baz => 'frew',
-				biff => 'frew',
-			})
-		} 'schema at version 3';
-		$handler->downgrade;
-		dies_ok {
-			$s->resultset('Foo')->create({
-				bar => 'frew',
-				baz => 'frew',
-				biff => 'frew',
-			})
-		} 'schema not at version 3';
-		lives_ok {
-			$s->resultset('Foo')->create({
-				bar => 'frew',
-				baz => 'frew',
-			})
-		} 'schema is at version 2';
-	}
-}
-
-
 1;
diff --git a/t/version_handlers/explict_versions.t b/t/version_handlers/explict_versions.t
index 6222c50..c432faf 100644
--- a/t/version_handlers/explict_versions.t
+++ b/t/version_handlers/explict_versions.t
@@ -119,7 +119,17 @@ dies_ok {
     database_version => '1.0',
   });
   $vh->next_version_set;
-} 'cannot request a version before the current version';
+} 'cannot request an upgrade before the current version';
+
+dies_ok {
+  my $vh = ExplicitVersions->new({
+    ordered_versions => $versions,
+    to_version => '2.0',
+    schema_version => '1.0',
+    database_version => '1.0',
+  });
+  $vh->previous_version_set;
+} 'cannot request a downgrade after the current version';
 
 done_testing;
 #vim: ts=2 sw=2 expandtab