[Bast-commits] r4172 - in DBIx-Class-Fixtures/1.001/trunk: . lib/DBIx/Class t t/lib

drew at dev.catalyst.perl.org drew at dev.catalyst.perl.org
Tue Mar 11 16:19:16 GMT 2008


Author: drew
Date: 2008-03-11 16:19:16 +0000 (Tue, 11 Mar 2008)
New Revision: 4172

Added:
   DBIx-Class-Fixtures/1.001/trunk/t/14-populate-post.t
   DBIx-Class-Fixtures/1.001/trunk/t/lib/post_sqlite.sql
Modified:
   DBIx-Class-Fixtures/1.001/trunk/Makefile.PL
   DBIx-Class-Fixtures/1.001/trunk/lib/DBIx/Class/Fixtures.pm
Log:
- Added post_ddl and cascade attributes to populate().
- Test for post_ddl attribute.
- Refactor sql reading into private function.
- Removed auto_provides() in Makefile.PL at direction of mst.


Modified: DBIx-Class-Fixtures/1.001/trunk/Makefile.PL
===================================================================
--- DBIx-Class-Fixtures/1.001/trunk/Makefile.PL	2008-03-11 15:10:50 UTC (rev 4171)
+++ DBIx-Class-Fixtures/1.001/trunk/Makefile.PL	2008-03-11 16:19:16 UTC (rev 4172)
@@ -22,8 +22,6 @@
 
 tests_recursive();
 
-auto_provides;
-
 auto_install;
 
 WriteAll;

Modified: DBIx-Class-Fixtures/1.001/trunk/lib/DBIx/Class/Fixtures.pm
===================================================================
--- DBIx-Class-Fixtures/1.001/trunk/lib/DBIx/Class/Fixtures.pm	2008-03-11 15:10:50 UTC (rev 4171)
+++ DBIx-Class-Fixtures/1.001/trunk/lib/DBIx/Class/Fixtures.pm	2008-03-11 16:19:16 UTC (rev 4172)
@@ -52,7 +52,8 @@
   $fixtures->populate({
     directory => '/home/me/app/fixtures',
     ddl => '/home/me/app/sql/ddl.sql',
-    connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password']
+    connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password'],
+    post_ddl => '/home/me/app/sql/post_ddl.sql',
   });
 
 =head1 DESCRIPTION
@@ -681,25 +682,22 @@
     return DBIx::Class::Exception->throw('connection details not valid');
   }
   my @tables = map { $pre_schema->source($_)->from } $pre_schema->sources;
+  $self->msg("Tables to drop: [". join(', ', sort @tables) . "]");
   my $dbh = $pre_schema->storage->dbh;
 
   # clear existing db
   $self->msg("- clearing DB of existing tables");
   eval { $dbh->do('SET foreign_key_checks=0') };
-  $dbh->do('drop table ' . $_) for (@tables);
+  foreach my $table (@tables) {
+    eval { $dbh->do('drop table ' . $table . ($params->{cascade} ? ' cascade' : '') ) };
+  }
 
   # import new ddl file to db
   my $ddl_file = $params->{ddl};
   $self->msg("- deploying schema using $ddl_file");
-  my $fh;
-  open $fh, "<$ddl_file" or die ("Can't open DDL file, $ddl_file ($!)");
-  my @data = split(/\n/, join('', <$fh>));
-  @data = grep(!/^--/, @data);
-  @data = split(/;/, join('', @data));
-  close($fh);
-  @data = grep { $_ && $_ !~ /^-- / } @data;
-  for (@data) {
-      eval { $dbh->do($_) or warn "SQL was:\n $_"};
+  my $data = _read_sql($ddl_file);
+  foreach (@$data) {
+    eval { $dbh->do($_) or warn "SQL was:\n $_"};
 	  if ($@) { die "SQL was:\n $_\n$@"; }
   }
   $self->msg("- finished importing DDL into DB");
@@ -712,6 +710,17 @@
   return $schema;
 }
 
+sub _read_sql {
+  my $ddl_file = shift;
+  my $fh;
+  open $fh, "<$ddl_file" or die ("Can't open DDL file, $ddl_file ($!)");
+  my @data = split(/\n/, join('', <$fh>));
+  @data = grep(!/^--/, @data);
+  @data = split(/;/, join('', @data));
+  close($fh);
+  @data = grep { $_ && $_ !~ /^-- / } @data;
+  return \@data;
+}
 
 =head2 populate
 
@@ -726,7 +735,9 @@
   $fixtures->populate({
     directory => '/home/me/app/fixtures', # directory to look for fixtures in, as specified to dump
     ddl => '/home/me/app/sql/ddl.sql', # DDL to deploy
-    connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password'] # database to clear, deploy and then populate
+    connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password'], # database to clear, deploy and then populate
+    post_ddl => '/home/me/app/sql/post_ddl.sql', # DDL to deploy after populating records, ie. FK constraints
+    cascade => 1, # use CASCADE option when dropping tables
   });
 
 In this case the database app_dev will be cleared of all tables, then the specified DDL deployed to it,
@@ -735,6 +746,13 @@
 custom insert methods are avoided which can to get in the way. In some cases you might not
 have a DDL, and so this method will eventually allow a $schema object to be passed instead.
 
+If needed, you can specify a post_ddl attribute which is a DDL to be applied after all the fixtures
+have been added to the database. A good use of this option would be to add foreign key constraints
+since databases like Postgresql cannot disable foreign key checks.
+
+If your tables have foreign key constraints you may want to use the cascade attribute which will
+make the drop table functionality cascade, ie 'DROP TABLE $table CASCADE'.
+
 directory, dll and connection_details are all required attributes.
 
 =cut
@@ -822,6 +840,15 @@
     }
   }
 
+  if ($params->{post_ddl}) {
+    my $data = _read_sql($params->{post_ddl});
+    foreach (@$data) {
+      eval { $schema->storage->dbh->do($_) or warn "SQL was:\n $_"};
+  	  if ($@) { die "SQL was:\n $_\n$@"; }
+    }
+    $self->msg("- finished importing post-populate DDL into DB");
+  }
+
   $self->msg("- fixtures imported");
   $self->msg("- cleaning up");
   $tmp_fixture_dir->rmtree;

Added: DBIx-Class-Fixtures/1.001/trunk/t/14-populate-post.t
===================================================================
--- DBIx-Class-Fixtures/1.001/trunk/t/14-populate-post.t	                        (rev 0)
+++ DBIx-Class-Fixtures/1.001/trunk/t/14-populate-post.t	2008-03-11 16:19:16 UTC (rev 4172)
@@ -0,0 +1,27 @@
+#!perl
+
+use DBIx::Class::Fixtures;
+use Test::More tests => 5;
+use lib qw(t/lib);
+use DBICTest;
+use Path::Class;
+use Data::Dumper;
+
+# set up and populate schema
+ok(my $schema = DBICTest->init_schema(), 'got schema');
+my $config_dir = 't/var/configs';
+
+# do dump
+ok(my $fixtures = DBIx::Class::Fixtures->new({ config_dir => $config_dir, debug => 0 }), 'object created with correct config dir');
+
+no warnings 'redefine';
+DBICTest->clear_schema($schema);
+DBICTest->populate_schema($schema);
+ok($fixtures->dump({ config => "simple.json", schema => $schema, directory => 't/var/fixtures' }), "simple dump executed okay");
+$fixtures->populate({ ddl => 't/lib/sqlite.sql', connection_details => ['dbi:SQLite:t/var/DBIxClass.db', '', ''], 
+  directory => 't/var/fixtures', post_ddl => 't/lib/post_sqlite.sql' });
+  
+my ($producer) = $schema->resultset('Producer')->find(999999);
+is($producer->name, "PostDDL", "Got producer name");
+isa_ok($producer, "DBICTest::Producer", "Got post-ddl producer");
+

Added: DBIx-Class-Fixtures/1.001/trunk/t/lib/post_sqlite.sql
===================================================================
--- DBIx-Class-Fixtures/1.001/trunk/t/lib/post_sqlite.sql	                        (rev 0)
+++ DBIx-Class-Fixtures/1.001/trunk/t/lib/post_sqlite.sql	2008-03-11 16:19:16 UTC (rev 4172)
@@ -0,0 +1,9 @@
+-- 
+-- Created by SQL::Translator::Producer::SQLite
+-- Created on Tue Aug  8 01:53:20 2006
+-- 
+BEGIN TRANSACTION;
+
+INSERT INTO producer (producerid, name) VALUES (999999, 'PostDDL');
+
+COMMIT;




More information about the Bast-commits mailing list