From: Gordon Irving <goraxe@cpan.org>
Date: Wed, 2 Dec 2009 21:49:27 +0000 (+0000)
Subject: get deployment tests to pass
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2ded40e7a8f53958ef16fcf83526c3073d9f7c39;p=dbsrgits%2FDBIx-Class-Historic.git

get deployment tests to pass
---

diff --git a/lib/DBIx/Class/Admin.pm b/lib/DBIx/Class/Admin.pm
index e6f8701..fcb2618 100644
--- a/lib/DBIx/Class/Admin.pm
+++ b/lib/DBIx/Class/Admin.pm
@@ -85,9 +85,10 @@ has 'schema' => (
 sub _build_schema {
 	my ($self)  = @_;
 	$self->ensure_class_loaded($self->schema_class);
-	warn Dumper $self->connect_info();
 
-	return $self->schema_class->connect($self->connect_info()},  $self->connect_info->[3], { ignore_version => 1} );
+	$self->connect_info->[3]->{ignore_version} =1;
+	#warn Dumper ($self->connect_info(), $self->connect_info->[3], {ignore_version => 1 });
+	return $self->schema_class->connect(@{$self->connect_info()} ); # ,  $self->connect_info->[3], { ignore_version => 1} );
 }
 
 has 'connect_info' => (
@@ -153,7 +154,7 @@ has preversion => (
 );
 
 sub create {
-	my ($self, $sqlt_type, ) = @_;
+	my ($self, $sqlt_type, $sqlt_args) = @_;
 	if ($self->has_preversion) {
 		print "attempting to create diff file for ".$self->preversion."\n";
 	}
@@ -162,7 +163,7 @@ sub create {
 	# create the dir if does not exist
 	$self->sql_dir->mkpath() if ( ! -d $self->sql_dir);
 
-	$schema->create_ddl_dir( $sqlt_type, (defined $schema->schema_version ? $schema->schema_version : ""), $self->sql_dir->stringify, $self->preversion );
+	$schema->create_ddl_dir( $sqlt_type, (defined $schema->schema_version ? $schema->schema_version : ""), $self->sql_dir->stringify, $self->preversion, $sqlt_args );
 }
 
 sub upgrade {
@@ -191,11 +192,15 @@ sub install {
 }
 
 sub deploy {
-	my ($self) = @_;
+	my ($self, $args) = @_;
 	my $schema = $self->schema();
 	if (!$schema->get_db_version() ) {
 		# schema is unversioned
-		$schema->deploy();
+#		warn "going to deploy";
+#		warn Dumper $schema->deployment_statements();
+		
+		$schema->deploy( $args, $self->sql_dir)
+			or die "could not deploy schema";
 	} else {
 		warn "there already is a database with a version here, try upgrade instead";
 	}
diff --git a/t/admin/02ddl.t b/t/admin/02ddl.t
index 7631390..11f37f9 100644
--- a/t/admin/02ddl.t
+++ b/t/admin/02ddl.t
@@ -24,6 +24,9 @@ use Test::Exception;
 
 use Path::Class;
 use FindBin qw($Bin);
+
+use Module::Load;
+
 use lib dir($Bin,'..', '..','lib')->stringify;
 use lib dir($Bin,'..', 'lib')->stringify;
 
@@ -33,48 +36,71 @@ use DBICTest;
 
 my $sql_dir = dir($Bin,"var","sql");
 
-
 { # create the schema
 
+#  make sure we are  clean
+clean_dir($sql_dir);
+
+# create a DBICTest so we can steal its connect info
 my $schema = DBICTest->init_schema(
     no_deploy=>1,
     no_populate=>1,
 	);
-	clean_dir($sql_dir);
+
+
 my $admin = DBIx::Class::Admin->new(
 	schema_class=> "DBICTest::Schema",
 	sql_dir=> $sql_dir,
 	connect_info => $schema->storage->connect_info() 
 );
-
+isa_ok ($admin, 'DBIx::Class::Admin', 'create the admin object');
 lives_ok { $admin->create('MySQL'); } 'Can create MySQL sql';
 lives_ok { $admin->create('SQLite'); } 'Can Create SQLite sql';
 }
 
-
 { # upgrade schema
 
 my $schema = DBICTest->init_schema(
-    no_deploy=>1,
-    no_populate=>1,
-	);
+	no_deploy		=> 1,
+	no_populat		=> 1,
+	sqlite_use_file	=> 1,
+);
 
-	clean_dir($sql_dir);
-use DBICVersionOrig;
+clean_dir($sql_dir);
+load 'DBICVersionOrig';
 
 my $admin = DBIx::Class::Admin->new(
 	schema_class => 'DBICVersion::Schema', 
 	sql_dir =>  $sql_dir,
 	connect_info => $schema->storage->connect_info(),
 );
-lives_ok { $admin->create($schema->storage->sqlt_type()); } 'Can create DBICVersionOrig sql in ' . $schema->storage->sqlt_type;
-lives_ok { $admin->deploy(); } 'Can Deploy schema';
+lives_ok { $admin->create($schema->storage->sqlt_type(), {add_drop_table=>0}); } 'Can create DBICVersionOrig sql in ' . $schema->storage->sqlt_type;
+lives_ok { $admin->deploy(  ) } 'Can Deploy schema';
+
+# connect to now deployed schema
+lives_ok { $schema = DBICVersion::Schema->connect(@{$schema->storage->connect_info()}); } 'Connect to deployed Database';
+
+is($schema->get_db_version, $DBICVersion::Schema::VERSION, 'Schema deployed and versions match');
+
+
+load 'DBICVersionNew';
+
+$admin = DBIx::Class::Admin->new(
+	schema_class => 'DBICVersion::Schema', 
+	sql_dir =>  $sql_dir,
+	connect_info => $schema->storage->connect_info(),
+);
+
+$admin->upgrade();
+
 
 }
 
 sub clean_dir {
 	my ($dir)  =@_;
 	foreach my $file ($dir->children) {
+		# skip any hidden files
+		next if ($file =~ /^\./); 
 		unlink $file;
 	}
 }