[Bast-commits] r3816 - in DBIx-Class/0.08/trunk: lib/SQL/Translator/Parser/DBIx t t/lib/DBICTest t/lib/DBICTest/Schema

[ash at dev.catalyst.perl.org]

Author: ash
Date: 2007-10-12 19:20:43 +0100 (Fri, 12 Oct 2007)
New Revision: 3816

Modified:
   DBIx-Class/0.08/trunk/lib/SQL/Translator/Parser/DBIx/Class.pm
   DBIx-Class/0.08/trunk/t/86sqlt.t
   DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema.pm
   DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/Artist.pm
Log:
Test sqlt_deploy_hook on the Schema level

Modified: DBIx-Class/0.08/trunk/lib/SQL/Translator/Parser/DBIx/Class.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/SQL/Translator/Parser/DBIx/Class.pm	2007-10-12 17:46:55 UTC (rev 3815)
+++ DBIx-Class/0.08/trunk/lib/SQL/Translator/Parser/DBIx/Class.pm	2007-10-12 18:20:43 UTC (rev 3816)
@@ -67,8 +67,6 @@
 
     foreach my $moniker (@monikers)
     {
-        #eval "use $tableclass";
-        #print("Can't load $tableclass"), next if($@);
         my $source = $dbixschema->source($moniker);
 
         next if $seen_tables{$source->name}++;
@@ -80,7 +78,7 @@
         my $colcount = 0;
         foreach my $col ($source->columns)
         {
-            # assuming column_info in dbix is the same as DBI (?)
+            # assuming column_info in dbic is the same as DBI (?)
             # data_type is a number, column_type is text?
             my %colinfo = (
               name => $col,
@@ -175,6 +173,11 @@
           $source->result_class->sqlt_deploy_hook($table);
         }
     }
+
+    if ($dbixschema->can('sqlt_deploy_hook')) {
+      $dbixschema->sqlt_deploy_hook($schema);
+    }
+
     return 1;
 }
 

Modified: DBIx-Class/0.08/trunk/t/86sqlt.t
===================================================================
--- DBIx-Class/0.08/trunk/t/86sqlt.t	2007-10-12 17:46:55 UTC (rev 3815)
+++ DBIx-Class/0.08/trunk/t/86sqlt.t	2007-10-12 18:20:43 UTC (rev 3816)
@@ -10,7 +10,7 @@
 
 my $schema = DBICTest->init_schema;
 
-plan tests => 55;
+plan tests => 56;
 
 my $translator = SQL::Translator->new( 
   parser_args => {
@@ -28,7 +28,6 @@
 ok($output, "SQLT produced someoutput")
   or diag($translator->error);
 
-
 # Note that the constraints listed here are the only ones that are tested -- if
 # more exist in the Schema than are listed here and all listed constraints are
 # correct, the test will still pass. If you add a class with UNIQUE or FOREIGN
@@ -224,6 +223,10 @@
 
 my $tschema = $translator->schema();
 
+# Test that the $schema->sqlt_deploy_hook was called okay and that it removed
+# the 'link' table
+ok( !defined($tschema->get_table('link')), "Link table was removed by hook");
+
 # Test that nonexistent constraints are not found
 my $constraint = get_constraint('FOREIGN KEY', 'cd', ['title'], 'cd', ['year']);
 ok( !defined($constraint), 'nonexistent FOREIGN KEY constraint not found' );

Modified: DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/Artist.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/Artist.pm	2007-10-12 17:46:55 UTC (rev 3815)
+++ DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema/Artist.pm	2007-10-12 18:20:43 UTC (rev 3816)
@@ -44,8 +44,11 @@
 sub sqlt_deploy_hook {
   my ($self, $sqlt_table) = @_;
 
-  $sqlt_table->add_index( name => 'artist_name', fields => ['name'] )
-    or die $sqlt_table->error;
+
+  if ($sqlt_table->schema->translator->producer_type =~ /SQLite$/ ) {
+    $sqlt_table->add_index( name => 'artist_name', fields => ['name'] )
+      or die $sqlt_table->error;
+  }
 }
 
 1;

Modified: DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema.pm
===================================================================
--- DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema.pm	2007-10-12 17:46:55 UTC (rev 3815)
+++ DBIx-Class/0.08/trunk/t/lib/DBICTest/Schema.pm	2007-10-12 18:20:43 UTC (rev 3816)
@@ -39,4 +39,10 @@
   qw/Owners BooksInLibrary/
 );
 
+sub sqlt_deploy_hook {
+  my ($self, $sqlt_schema) = @_;
+
+  $sqlt_schema->drop_table('link');
+}
+
 1;