[Bast-commits] r8012 - in DBIx-Class/0.08/branches/dbicadmin_refactor: lib/DBIx/Class t/admin

[goraxe at dev.catalyst.perl.org]

Author: goraxe
Date: 2009-12-02 21:49:27 +0000 (Wed, 02 Dec 2009)
New Revision: 8012

Modified:
   DBIx-Class/0.08/branches/dbicadmin_refactor/lib/DBIx/Class/Admin.pm
   DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/02ddl.t
Log:
get deployment tests to pass

Modified: DBIx-Class/0.08/branches/dbicadmin_refactor/lib/DBIx/Class/Admin.pm
===================================================================
--- DBIx-Class/0.08/branches/dbicadmin_refactor/lib/DBIx/Class/Admin.pm	2009-12-02 21:13:02 UTC (rev 8011)
+++ DBIx-Class/0.08/branches/dbicadmin_refactor/lib/DBIx/Class/Admin.pm	2009-12-02 21:49:27 UTC (rev 8012)
@@ -85,9 +85,10 @@
 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 @@
 );
 
 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 @@
 	# 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 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";
 	}

Modified: DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/02ddl.t
===================================================================
--- DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/02ddl.t	2009-12-02 21:13:02 UTC (rev 8011)
+++ DBIx-Class/0.08/branches/dbicadmin_refactor/t/admin/02ddl.t	2009-12-02 21:49:27 UTC (rev 8012)
@@ -24,6 +24,9 @@
 
 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 @@
 
 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;
 	}
 }