add an option to exclude some sources from the all option
[dbsrgits/DBIx-Class-Fixtures.git] / lib / DBIx / Class / Fixtures.pm
index a805c96..4f995b9 100644 (file)
@@ -26,11 +26,11 @@ __PACKAGE__->mk_group_accessors( 'simple' => qw/config_dir
 
 =head1 VERSION
 
-Version 1.001000
+Version 1.001010
 
 =cut
 
-our $VERSION = '1.001003';
+our $VERSION = '1.001010';
 
 =head1 NAME
 
@@ -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,10 +422,11 @@ 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},
-              dumped_objects => {}
+              dumped_objects => {},
+              use_create => $params->{use_create} || 0
   };
 
   bless $self, $class;
@@ -483,6 +484,10 @@ 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}) {
@@ -490,11 +495,17 @@ sub dump {
     my $config_file = $self->config_dir->file($params->{config});
     $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');
@@ -524,6 +535,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}};
@@ -716,7 +733,7 @@ sub dump_object {
 
   # don't bother looking at rels unless we are actually planning to dump at least one type
   my ($might_have, $belongs_to, $has_many) = map {
-    $set->{$_}{fetch};
+    $set->{$_}{fetch} || $set->{rules}{$src->source_name}{$_}{fetch}
   } qw/might_have belongs_to has_many/;
 
   return unless $might_have
@@ -857,12 +874,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
@@ -924,6 +943,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
@@ -1036,26 +1060,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 = $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;
-        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}
@@ -1105,6 +1134,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