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

lukes at dev.catalyst.perl.org lukes at dev.catalyst.perl.org
Fri Aug 1 13:04:35 BST 2008


Author: lukes
Date: 2008-08-01 13:04:35 +0100 (Fri, 01 Aug 2008)
New Revision: 4713

Added:
   DBIx-Class-Fixtures/1.001/trunk/t/10-dump-cleanup.t
Modified:
   DBIx-Class-Fixtures/1.001/trunk/lib/DBIx/Class/Fixtures.pm
Log:
set debug to 0 by default and made cleanup more precise

Modified: DBIx-Class-Fixtures/1.001/trunk/lib/DBIx/Class/Fixtures.pm
===================================================================
--- DBIx-Class-Fixtures/1.001/trunk/lib/DBIx/Class/Fixtures.pm	2008-08-01 11:29:34 UTC (rev 4712)
+++ DBIx-Class-Fixtures/1.001/trunk/lib/DBIx/Class/Fixtures.pm	2008-08-01 12:04:35 UTC (rev 4713)
@@ -370,7 +370,7 @@
   my $self = {
               config_dir => $config_dir,
               _inherited_attributes => [qw/datetime_relative might_have rules/],
-              debug => $params->{debug},
+              debug => $params->{debug} || 0,
               ignore_sql_errors => $params->{ignore_sql_errors}
   };
 
@@ -548,9 +548,16 @@
     $self->dump_object(@$entry);
   }
 
-  foreach my $dir ($output_dir->children) {
-    next if ($dir eq $tmp_output_dir);
-    $dir->remove || $dir->rmtree;
+  # clear existing output dir
+  foreach my $child ($output_dir->children) {
+    if ($child->is_dir) {
+      next if ($child eq $tmp_output_dir);
+      if (grep { $_ =~ /\.fix/ } $child->children) {
+        $child->rmtree;
+      }
+    } elsif ($child =~ /_dumper_version$/) {
+      $child->remove;
+    }
   }
 
   $self->msg("- moving temp dir to $output_dir");

Added: DBIx-Class-Fixtures/1.001/trunk/t/10-dump-cleanup.t
===================================================================
--- DBIx-Class-Fixtures/1.001/trunk/t/10-dump-cleanup.t	                        (rev 0)
+++ DBIx-Class-Fixtures/1.001/trunk/t/10-dump-cleanup.t	2008-08-01 12:04:35 UTC (rev 4713)
@@ -0,0 +1,27 @@
+#!perl
+
+use DBIx::Class::Fixtures;
+use Test::More tests => 4;
+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 }), 'object created with correct config dir');
+
+my $output_dir = dir('t/var/fixtures');
+$output_dir->mkpath;
+my $file = file($output_dir, 'test_file');
+my $fh = $file->open('w');
+print $fh 'test file';
+$fh->close;
+
+ok($fixtures->dump({ config => 'simple.json', schema => $schema, directory => 't/var/fixtures' }), 'simple dump executed okay');
+
+ok(-e $file, 'file still exists');




More information about the Bast-commits mailing list