fixed problems with new features in last release
[dbsrgits/DBIx-Class-Fixtures.git] / lib / DBIx / Class / Fixtures.pm
index 005c8a0..50b9fdf 100644 (file)
@@ -3,7 +3,7 @@ package DBIx::Class::Fixtures;
 use strict;
 use warnings;
 
-use DBIx::Class 0.08099_07;
+use DBIx::Class 0.08100;
 use DBIx::Class::Exception;
 use Class::Accessor::Grouped;
 use Path::Class qw(dir file);
@@ -26,15 +26,15 @@ __PACKAGE__->mk_group_accessors( 'simple' => qw/config_dir
 
 =head1 VERSION
 
-Version 1.001000
+Version 1.001013
 
 =cut
 
-our $VERSION = '1.001002';
+our $VERSION = '1.001013';
 
 =head1 NAME
 
-DBIx::Class::Fixtures
+DBIx::Class::Fixtures - Dump data and repopulate a database using rules
 
 =head1 SYNOPSIS
 
@@ -76,18 +76,18 @@ describe which data to pull and dump from the source database.
 For example:
 
  {
-   sets: [
+   "sets": [
      {
-       class: 'Artist',
-       ids: ['1', '3']
+       "class": "Artist",
+       "ids": ["1", "3"]
      },
      {
-       class: 'Producer',
-       ids: ['5'],
-       fetch: [
+       "class": "Producer",
+       "ids": ["5"],
+       "fetch": [
          {
-           rel: 'artists',
-           quantity: '2'
+           "rel": "artists",
+           "quantity": "2"
          }
        ]
      }
@@ -113,27 +113,27 @@ was dumped you also wanted all of their cds dumped too, then you could use a
 rule to specify this. For example:
 
  {
-   sets: [
+   "sets": [
      {
-       class: 'Artist',
-       ids: ['1', '3']
+       "class": "Artist",
+       "ids": ["1", "3"]
      }, 
      {
-       class: 'Producer',
-       ids: ['5'],
-       fetch: [
+       "class": "Producer",
+       "ids": ["5"],
+       "fetch": [
          { 
-           rel: 'artists',
-           quantity: '2'
+           "rel": "artists",
+           "quantity": "2"
          }
        ]
      }
    ],
-   rules: {
-     Artist: {
-       fetch: [ {
-         rel: 'cds',
-         quantity: 'all'
+   "rules": {
+     "Artist": {
+       "fetch": [ {
+         "rel": "cds",
+         "quantity": "all"
        } ]
      }
    }
@@ -144,24 +144,24 @@ dumped as well. Note that 'cds' is a has_many DBIx::Class relation from Artist
 to CD. This is eqivalent to:
 
  {
-   sets: [
+   "sets": [
     {
-       class: 'Artist',
-       ids: ['1', '3'],
-       fetch: [ {
-         rel: 'cds',
-         quantity: 'all'
+       "class": "Artist",
+       "ids": ["1", "3"],
+       "fetch": [ {
+         "rel": "cds",
+         "quantity": "all"
        } ]
      }, 
      {
-       class: 'Producer',
-       ids: ['5'],
-       fetch: [ { 
-         rel: 'artists',
-         quantity: '2',
-         fetch: [ {
-           rel: 'cds',
-           quantity: 'all'
+       "class": "Producer",
+       "ids": ["5"],
+       "fetch": [ { 
+         "rel": "artists",
+         "quantity": "2",
+         "fetch": [ {
+           "rel": "cds",
+           "quantity": "all"
          } ]
        } ]
      }
@@ -178,12 +178,12 @@ To prevent repetition between configs you can include other configs. For
 example:
 
  {
-   sets: [ {
-     class: 'Producer',
-     ids: ['5']
+   "sets": [ {
+     "class": "Producer",
+     "ids": ["5"]
    } ],
-   includes: [
-     { file: 'base.json' }
+   "includes": [
+     { "file": "base.json" }
    ]
  }
 
@@ -197,11 +197,11 @@ Only available for MySQL and PostgreSQL at the moment, must be a value that
 DateTime::Format::* can parse. For example:
 
  {
-   sets: [ {
-     class: 'RecentItems',
-     ids: ['9']
+   "sets": [ {
+     "class": "RecentItems",
+     "ids": ["9"]
    } ],
-   datetime_relative : "2007-10-30 00:00:00"
+   "datetime_relative": "2007-10-30 00:00:00"
  }
 
 This will work when dumping from a MySQL database and will cause any datetime
@@ -217,15 +217,15 @@ Specifies whether to automatically dump might_have relationships. Should be a
 hash with one attribute - fetch. Set fetch to 1 or 0.
 
  {
-   might_have: { fetch: 1 },
-   sets: [
+   "might_have": { "fetch": 1 },
+   "sets": [
      {
-       class: 'Artist',
-       ids: ['1', '3']
+       "class": "Artist",
+       "ids": ["1", "3"]
      },
      {
-       class: 'Producer',
-       ids: ['5']
+       "class": "Producer",
+       "ids": ["5"]
      }
    ]
  }
@@ -260,10 +260,10 @@ A hash specifying the conditions dumped objects must match. Essentially this is
 a JSON representation of a DBIx::Class search clause. For example:
 
  {
-   sets: [{
-     class: 'Artist',
-     quantiy: 'all',
-     cond: { name: 'Dave' }
+   "sets": [{
+     "class": "Artist",
+     "quantiy": "all",
+     "cond": { "name": "Dave" }
    }]
  }
 
@@ -277,10 +277,10 @@ Sometimes in a search clause it's useful to use scalar refs to do things like:
 This could be specified in the cond hash like so:
 
  {
-   sets: [ {
-     class: 'Artist',
-     quantiy: 'all',
-     cond: { no1_singles: '\> no1_albums' }
+   "sets": [ {
+     "class": "Artist",
+     "quantiy": "all",
+     "cond": { "no1_singles": "\> no1_albums" }
    } ]
  }
 
@@ -292,11 +292,11 @@ being passed to search.
 An array of relationships to be used in the cond clause.
 
  {
-   sets: [ {
-     class: 'Artist',
-     quantiy: 'all',
-     cond: { 'cds.position': { '>': 4 } },
-     join: ['cds']
+   "sets": [ {
+     "class": "Artist",
+     "quantiy": "all",
+     "cond": { "cds.position": { ">": 4 } },
+     "join": ["cds"]
    } ]
  }
 
@@ -307,13 +307,13 @@ Fetch all artists who have cds with position greater than 4.
 Must be an array of hashes. Specifies which rels to also dump. For example:
 
  {
-   sets: [ {
-     class: 'Artist',
-     ids: ['1', '3'],
-     fetch: [ {
-       rel: 'cds',
-       quantity: '3',
-       cond: { position: '2' }
+   "sets": [ {
+     "class": "Artist",
+     "ids": ["1", "3"],
+     "fetch": [ {
+       "rel": "cds",
+       "quantity": "3",
+       "cond": { "position": "2" }
      } ]
    } ]
  }
@@ -422,18 +422,34 @@ sub new {
 
   my $self = {
               config_dir => $config_dir,
-              _inherited_attributes => [qw/datetime_relative might_have rules/],
+              _inherited_attributes => [qw/datetime_relative might_have rules belongs_to/],
               debug => $params->{debug} || 0,
-              ignore_sql_errors => $params->{ignore_sql_errors}
+              ignore_sql_errors => $params->{ignore_sql_errors},
+              dumped_objects => {},
+              use_create => $params->{use_create} || 0
   };
 
   bless $self, $class;
 
-  $self->dumped_objects({});
-
   return $self;
 }
 
+=head2 available_config_sets
+
+Returns a list of all the config sets found in the L</config_dir>.  These will
+be a list of the json based files containing dump rules.
+
+=cut
+
+my @config_sets;
+sub available_config_sets {
+  @config_sets = scalar(@config_sets) ? @config_sets : map {
+    $_->basename;
+  } grep { 
+    -f $_ && $_=~/json$/;
+  } dir((shift)->config_dir)->children;
+}
+
 =head2 dump
 
 =over 4
@@ -466,7 +482,12 @@ directory. For example:
  /home/me/app/fixtures/artist/3.fix
  /home/me/app/fixtures/producer/5.fix
 
-schema and directory are required attributes. also, one of config or all must be specified.
+schema and directory are required attributes. also, one of config or all must
+be specified.
+
+Lastly, the C<config> parameter can be a Perl HashRef instead of a file name.
+If this form is used your HashRef should conform to the structure rules defined
+for the JSON representations.
 
 =cut
 
@@ -484,18 +505,32 @@ sub dump {
     }
   }
 
+  if($params->{excludes} && !$params->{all}) {
+    return DBIx::Class::Exception->throw("'excludes' param only works when using the 'all' param");
+  }
+
   my $schema = $params->{schema};
   my $config;
   if ($params->{config}) {
-    #read config
-    my $config_file = $self->config_dir->file($params->{config});
-    $config = $self->load_config_file($config_file);
+    $config = ref $params->{config} eq 'HASH' ? 
+      $params->{config} : 
+      do {
+        #read config
+        my $config_file = $self->config_dir->file($params->{config});
+        $self->load_config_file($config_file);
+      };
   } elsif ($params->{all}) {
+    my %excludes = map {$_=>1} @{$params->{excludes}||[]};
     $config = { 
       might_have => { fetch => 0 },
       has_many => { fetch => 0 },
       belongs_to => { fetch => 0 },
-      sets => [map {{ class => $_, quantity => 'all' }} $schema->sources] 
+      sets => [
+        map {
+          { class => $_, quantity => 'all' };
+        } grep {
+          !$excludes{$_}
+        } $schema->sources],
     };
   } else {
     DBIx::Class::Exception->throw('must pass config or set all');
@@ -525,6 +560,12 @@ sub dump {
   $config->{rules} ||= {};
   my @sources = sort { $a->{class} cmp $b->{class} } @{delete $config->{sets}};
 
+  while ( my ($k,$v) = each %{ $config->{rules} } ) {
+    if ( my $source = eval { $schema->source($k) } ) {
+      $config->{rules}{$source->source_name} = $v;
+    }
+  }
+
   foreach my $source (@sources) {
     # apply rule to set if specified
     my $rule = $config->{rules}->{$source->{class}};
@@ -534,20 +575,30 @@ sub dump {
     my $rs = $schema->resultset($source->{class});
 
     if ($source->{cond} and ref $source->{cond} eq 'HASH') {
-      # if value starts with \ assume it's meant to be passed as a scalar ref to dbic
-      # ideally this would substitute deeply
-      $source->{cond} = { map { $_ => ($source->{cond}->{$_} =~ s/^\\//) ? \$source->{cond}->{$_} : $source->{cond}->{$_} } keys %{$source->{cond}} };
+      # if value starts with \ assume it's meant to be passed as a scalar ref
+      # to dbic. ideally this would substitute deeply
+      $source->{cond} = { 
+        map { 
+          $_ => ($source->{cond}->{$_} =~ s/^\\//) ? \$source->{cond}->{$_} 
+                                                   : $source->{cond}->{$_} 
+        } keys %{$source->{cond}} 
+      };
     }
 
-    $rs = $rs->search($source->{cond}, { join => $source->{join} }) if ($source->{cond});
+    $rs = $rs->search($source->{cond}, { join => $source->{join} }) 
+      if $source->{cond};
+
     $self->msg("- dumping $source->{class}");
+
     my %source_options = ( set => { %{$config}, %{$source} } );
     if ($source->{quantity}) {
-      $rs = $rs->search({}, { order_by => $source->{order_by} }) if ($source->{order_by});
+      $rs = $rs->search({}, { order_by => $source->{order_by} }) 
+        if $source->{order_by};
+
       if ($source->{quantity} =~ /^\d+$/) {
         $rs = $rs->search({}, { rows => $source->{quantity} });
       } elsif ($source->{quantity} ne 'all') {
-        DBIx::Class::Exception->throw('invalid value for quantity - ' . $source->{quantity});
+        DBIx::Class::Exception->throw("invalid value for quantity - $source->{quantity}");
       }
     }
     elsif ($source->{ids} && @{$source->{ids}}) {
@@ -665,7 +716,9 @@ sub dump_object {
   $source_dir->mkpath(0, 0777);
 
   # strip dir separators from file name
-  my $file = $source_dir->file(join('-', map { s|[/\\]|_|g; $_; } @pk_vals) . '.fix');
+  my $file = $source_dir->file(
+      join('-', map { s|[/\\]|_|g; $_; } @pk_vals) . '.fix'
+  );
 
 
   # write file
@@ -704,9 +757,13 @@ sub dump_object {
   }
 
   # don't bother looking at rels unless we are actually planning to dump at least one type
-  return unless $set->{might_have}->{fetch} 
-             || $set->{belongs_to}->{fetch} 
-             || $set->{has_many}->{fetch} 
+  my ($might_have, $belongs_to, $has_many) = map {
+    $set->{$_}{fetch} || $set->{rules}{$src->source_name}{$_}{fetch}
+  } qw/might_have belongs_to has_many/;
+
+  return unless $might_have
+             || $belongs_to
+             || $has_many
              || $set->{fetch};
 
   # dump rels of object
@@ -714,32 +771,54 @@ sub dump_object {
     foreach my $name (sort $src->relationships) {
       my $info = $src->relationship_info($name);
       my $r_source = $src->related_source($name);
-      # if belongs_to or might_have with might_have param set or has_many with has_many param set then
+      # if belongs_to or might_have with might_have param set or has_many with
+      # has_many param set then
       if (
-            (   $info->{attrs}{accessor} eq 'single' && 
-                (!$info->{attrs}{join_type} || ($set->{might_have} && $set->{might_have}->{fetch}))
-            ) || 
-            $info->{attrs}{accessor} eq 'filter' || 
-            ($info->{attrs}{accessor} eq 'multi' && ($set->{has_many} && $set->{has_many}->{fetch}))
+            ( $info->{attrs}{accessor} eq 'single' && 
+              (!$info->{attrs}{join_type} || $might_have) 
+            )
+         || $info->{attrs}{accessor} eq 'filter' 
+         || 
+            ($info->{attrs}{accessor} eq 'multi' && $has_many)
       ) {
         my $related_rs = $object->related_resultset($name);      
         my $rule = $set->{rules}->{$related_rs->result_source->source_name};
         # these parts of the rule only apply to has_many rels
         if ($rule && $info->{attrs}{accessor} eq 'multi') {              
-          $related_rs = $related_rs->search($rule->{cond}, { join => $rule->{join} }) if ($rule->{cond});
-          $related_rs = $related_rs->search({}, { rows => $rule->{quantity} }) if ($rule->{quantity} && $rule->{quantity} ne 'all');
-          $related_rs = $related_rs->search({}, { order_by => $rule->{order_by} }) if ($rule->{order_by});               
+          $related_rs = $related_rs->search(
+            $rule->{cond}, 
+            { join => $rule->{join} }
+          ) if ($rule->{cond});
+
+          $related_rs = $related_rs->search(
+            {},
+            { rows => $rule->{quantity} }
+          ) if ($rule->{quantity} && $rule->{quantity} ne 'all');
+
+          $related_rs = $related_rs->search(
+            {}, 
+            { order_by => $rule->{order_by} }
+          ) if ($rule->{order_by});              
+
         }
-        if ($set->{has_many}->{quantity} && $set->{has_many}->{quantity} =~ /^\d+$/) {
-          $related_rs = $related_rs->search({}, { rows => $set->{has_many}->{quantity} });
+        if ($set->{has_many}{quantity} && 
+            $set->{has_many}{quantity} =~ /^\d+$/) {
+          $related_rs = $related_rs->search(
+            {}, 
+            { rows => $set->{has_many}->{quantity} }
+          );
         }
+
         my %c_params = %{$params};
         # inherit date param
-        my %mock_set = map { $_ => $set->{$_} } grep { $set->{$_} } @inherited_attrs;
+        my %mock_set = map { 
+          $_ => $set->{$_} 
+        } grep { $set->{$_} } @inherited_attrs;
+
         $c_params{set} = \%mock_set;
-        #              use Data::Dumper; print ' -- ' . Dumper($c_params{set}, $rule->{fetch}) if ($rule && $rule->{fetch});
-        $c_params{set} = merge( $c_params{set}, $rule) if ($rule && $rule->{fetch});
-        #              use Data::Dumper; print ' -- ' . Dumper(\%c_params) if ($rule && $rule->{fetch});
+        $c_params{set} = merge( $c_params{set}, $rule)
+          if $rule && $rule->{fetch};
+
         $self->dump_rs($related_rs, \%c_params);
       }        
     }
@@ -748,7 +827,8 @@ sub dump_object {
   return unless $set && $set->{fetch};
   foreach my $fetch (@{$set->{fetch}}) {
     # inherit date param
-    $fetch->{$_} = $set->{$_} foreach grep { !$fetch->{$_} && $set->{$_} } @inherited_attrs;
+    $fetch->{$_} = $set->{$_} foreach 
+      grep { !$fetch->{$_} && $set->{$_} } @inherited_attrs;
     my $related_rs = $object->related_resultset($fetch->{rel});
     my $rule = $set->{rules}->{$related_rs->result_source->source_name};
 
@@ -761,24 +841,31 @@ sub dump_object {
       }
     } 
 
-    die "relationship " . $fetch->{rel} . " does not exist for " . $src->source_name 
+    die "relationship $fetch->{rel} does not exist for " . $src->source_name 
       unless ($related_rs);
 
     if ($fetch->{cond} and ref $fetch->{cond} eq 'HASH') {
-      # if value starts with \ assume it's meant to be passed as a scalar ref to dbic
-      # ideally this would substitute deeply
+      # if value starts with \ assume it's meant to be passed as a scalar ref
+      # to dbic.  ideally this would substitute deeply
       $fetch->{cond} = { map { 
           $_ => ($fetch->{cond}->{$_} =~ s/^\\//) ? \$fetch->{cond}->{$_} 
                                                   : $fetch->{cond}->{$_} 
       } keys %{$fetch->{cond}} };
     }
 
-    $related_rs = $related_rs->search($fetch->{cond}, { join => $fetch->{join} }) 
-      if ($fetch->{cond});
-    $related_rs = $related_rs->search({}, { rows => $fetch->{quantity} })
-      if ($fetch->{quantity} && $fetch->{quantity} ne 'all');
-    $related_rs = $related_rs->search({}, { order_by => $fetch->{order_by} })
-      if ($fetch->{order_by});
+    $related_rs = $related_rs->search(
+      $fetch->{cond}, 
+      { join => $fetch->{join} }
+    ) if $fetch->{cond};
+
+    $related_rs = $related_rs->search(
+      {},
+      { rows => $fetch->{quantity} }
+    ) if $fetch->{quantity} && $fetch->{quantity} ne 'all';
+    $related_rs = $related_rs->search(
+      {}, 
+      { order_by => $fetch->{order_by} }
+    ) if $fetch->{order_by};
 
     $self->dump_rs($related_rs, { %{$params}, set => $fetch });
   }
@@ -789,7 +876,6 @@ sub _generate_schema {
   my $params = shift || {};
   require DBI;
   $self->msg("\ncreating schema");
-  #   die 'must pass version param to generate_schema_from_ddl' unless $params->{version};
 
   my $schema_class = $self->schema_class || "DBIx::Class::Fixtures::Schema";
   eval "require $schema_class";
@@ -813,12 +899,14 @@ sub _generate_schema {
 
   # clear existing db
   $self->msg("- clearing DB of existing tables");
-  $pre_schema->storage->with_deferred_fk_checks(sub {
-    foreach my $table (@tables) {
-      eval { 
-        $dbh->do("drop table $table" . ($params->{cascade} ? ' cascade' : '') ) 
-      };
-    }
+  $pre_schema->storage->txn_do(sub {
+    $pre_schema->storage->with_deferred_fk_checks(sub {
+      foreach my $table (@tables) {
+        eval { 
+          $dbh->do("drop table $table" . ($params->{cascade} ? ' cascade' : '') ) 
+        };
+      }
+    });
   });
 
   # import new ddl file to db
@@ -833,7 +921,7 @@ sub _generate_schema {
 
   # load schema object from our new DB
   $namespace_counter++;
-  my $namespace2 = "DBIx::Class::Fixtures::GeneratedSchema_" . $namespace_counter;
+  my $namespace2 = "DBIx::Class::Fixtures::GeneratedSchema_$namespace_counter";
   Class::C3::Componentised->inject_base( $namespace2 => $schema_class );
   my $schema = $namespace2->connect(@{$connection_details});
   return $schema;
@@ -851,6 +939,79 @@ sub _read_sql {
   return \@data;
 }
 
+=head2 dump_config_sets
+
+Works just like L</dump> but instead of specifying a single json config set
+located in L</config_dir> we dump each set named in the C<configs> parameter.
+
+The parameters are the same as for L</dump> except instead of a C<directory>
+parameter we have a C<directory_template> which is a coderef expected to return
+a scalar that is a root directory where we will do the actual dumping.  This
+coderef get three arguments: C<$self>, C<$params> and C<$set_name>.  For
+example:
+
+    $fixture->dump_all_config_sets({
+      schema => $schema,
+      configs => [qw/one.json other.json/],
+      directory_template => sub {
+        my ($fixture, $params, $set) = @_;
+        return File::Spec->catdir('var', 'fixtures', $params->{schema}->version, $set);
+      },
+    });
+
+=cut
+
+sub dump_config_sets {
+  my ($self, $params) = @_;
+  my $available_config_sets = delete $params->{configs};
+  my $directory_template = delete $params->{directory_template} ||
+    DBIx::Class::Exception->throw("'directory_template is required parameter");
+
+  for my $set (@$available_config_sets) {
+    my $localparams = $params;
+    $localparams->{directory} = $directory_template->($self, $localparams, $set);
+    $localparams->{config} = $set;
+    $self->dump($localparams);
+    $self->dumped_objects({}); ## Clear dumped for next go, if there is one!
+  }
+}
+
+=head2 dump_all_config_sets
+
+    my %local_params = %$params;
+    my $local_self = bless { %$self }, ref($self);
+    $local_params{directory} = $directory_template->($self, \%local_params, $set);
+    $local_params{config} = $set;
+    $self->dump(\%local_params);
+
+
+Works just like L</dump> but instead of specifying a single json config set
+located in L</config_dir> we dump each set in turn to the specified directory.
+
+The parameters are the same as for L</dump> except instead of a C<directory>
+parameter we have a C<directory_template> which is a coderef expected to return
+a scalar that is a root directory where we will do the actual dumping.  This
+coderef get three arguments: C<$self>, C<$params> and C<$set_name>.  For
+example:
+
+    $fixture->dump_all_config_sets({
+      schema => $schema,
+      directory_template => sub {
+        my ($fixture, $params, $set) = @_;
+        return File::Spec->catdir('var', 'fixtures', $params->{schema}->version, $set);
+      },
+    });
+
+=cut
+
+sub dump_all_config_sets {
+  my ($self, $params) = @_;
+  $self->dump_config_sets({
+    %$params,
+    configs=>[$self->available_config_sets],
+  });
+}
+
 =head2 populate
 
 =over 4
@@ -880,6 +1041,11 @@ sub _read_sql {
    # optional, set to 1 to run ddl but not populate 
    no_populate => 0,
 
+       # optional, set to 1 to run each fixture through ->create rather than have
+   # each $rs populated using $rs->populate. Useful if you have overridden new() logic
+       # that effects the value of column(s).
+       use_create => 0,
+
    # Dont try to clean the database, just populate over whats there. Requires
    # schema option. Use this if you want to handle removing old data yourself
    # no_deploy => 1
@@ -918,19 +1084,15 @@ C<no_deploy> attribute.
 sub populate {
   my $self = shift;
   my ($params) = @_;
-  unless (ref $params eq 'HASH') {
-    return DBIx::Class::Exception->throw('first arg to populate must be hash ref');
-  }
+  DBIx::Class::Exception->throw('first arg to populate must be hash ref')
+    unless ref $params eq 'HASH';
+
+  DBIx::Class::Exception->throw('directory param not specified')
+    unless $params->{directory};
 
-  foreach my $param (qw/directory/) {
-    unless ($params->{$param}) {
-      return DBIx::Class::Exception->throw($param . ' param not specified');
-    }
-  }
   my $fixture_dir = dir(delete $params->{directory});
-  unless (-e $fixture_dir) {
-    return DBIx::Class::Exception->throw('fixture directory does not exist at ' . $fixture_dir);
-  }
+  DBIx::Class::Exception->throw("fixture directory '$fixture_dir' does not exist")
+    unless -d $fixture_dir;
 
   my $ddl_file;
   my $dbh;
@@ -951,7 +1113,7 @@ sub populate {
   } elsif ($params->{schema} && $params->{no_deploy}) {
     $schema = $params->{schema};
   } else {
-    return DBIx::Class::Exception->throw('you must set the ddl and connection_details params');
+    DBIx::Class::Exception->throw('you must set the ddl and connection_details params');
   }
 
 
@@ -959,28 +1121,28 @@ sub populate {
   
   $self->msg("\nimporting fixtures");
   my $tmp_fixture_dir = dir($fixture_dir, "-~populate~-" . $<);
-
   my $version_file = file($fixture_dir, '_dumper_version');
-  unless (-e $version_file) {
-#     return DBIx::Class::Exception->throw('no version file found');
-  }
+#  DBIx::Class::Exception->throw('no version file found');
+#    unless -e $version_file;
 
   if (-e $tmp_fixture_dir) {
     $self->msg("- deleting existing temp directory $tmp_fixture_dir");
     $tmp_fixture_dir->rmtree;
   }
   $self->msg("- creating temp dir");
-  dircopy(
-      dir($fixture_dir, $schema->source($_)->from), 
-      dir($tmp_fixture_dir, $schema->source($_)->from)
-    ) for grep { -e dir($fixture_dir, $schema->source($_)->from) } $schema->sources;
+  $tmp_fixture_dir->mkpath();
+  for ( map { $schema->source($_)->from } $schema->sources) {
+    my $from_dir = $fixture_dir->subdir($_);
+    next unless -e $from_dir;
+    dircopy($from_dir, $tmp_fixture_dir->subdir($_) );
+  }
 
   unless (-d $tmp_fixture_dir) {
-    return DBIx::Class::Exception->throw("Unable to create temporary fixtures dir: $tmp_fixture_dir: $!");
+    DBIx::Class::Exception->throw("Unable to create temporary fixtures dir: $tmp_fixture_dir: $!");
   }
 
   my $fixup_visitor;
-  my $formatter= $schema->storage->datetime_parser;
+  my $formatter = $schema->storage->datetime_parser;
   unless ($@ || !$formatter) {
     my %callbacks;
     if ($params->{datetime_relative_to}) {
@@ -996,26 +1158,31 @@ sub populate {
     $fixup_visitor = new Data::Visitor::Callback(%callbacks);
   }
 
-  $schema->storage->with_deferred_fk_checks(sub {
-    foreach my $source (sort $schema->sources) {
-      $self->msg("- adding " . $source);
-      my $rs = $schema->resultset($source);
-      my $source_dir = dir($tmp_fixture_dir, lc($rs->result_source->from));
-      next unless (-e $source_dir);
-      my @rows;
-      while (my $file = $source_dir->next) {
-        next unless ($file =~ /\.fix$/);
-        next if $file->is_dir;
-        my $contents = $file->slurp;
-        my $HASH1;
-        eval($contents);
-        $HASH1 = $fixup_visitor->visit($HASH1) if $fixup_visitor;
-        push(@rows, $HASH1);
+  $schema->storage->txn_do(sub {
+    $schema->storage->with_deferred_fk_checks(sub {
+      foreach my $source (sort $schema->sources) {
+        $self->msg("- adding " . $source);
+        my $rs = $schema->resultset($source);
+        my $source_dir = $tmp_fixture_dir->subdir( lc $rs->result_source->from );
+        next unless (-e $source_dir);
+        my @rows;
+        while (my $file = $source_dir->next) {
+          next unless ($file =~ /\.fix$/);
+          next if $file->is_dir;
+          my $contents = $file->slurp;
+          my $HASH1;
+          eval($contents);
+          $HASH1 = $fixup_visitor->visit($HASH1) if $fixup_visitor;
+          if ( $params->{use_create} ) {
+            $rs->create( $HASH1 );
+          } else {
+            push(@rows, $HASH1);
+          }
+        }
+        $rs->populate(\@rows) if scalar(@rows);
       }
-      $rs->populate(\@rows) if (scalar(@rows));
-    }
+    });
   });
-
   $self->do_post_ddl( {
     schema=>$schema, 
     post_ddl=>$params->{post_ddl}
@@ -1065,6 +1232,8 @@ sub msg {
 
   Drew Taylor <taylor.andrew.j@gmail.com>
 
+  Frank Switalski <fswitalski@gmail.com>
+
 =head1 LICENSE
 
   This library is free software under the same license as perl itself