remove Dwarn statement

[dbsrgits/DBIx-Class-Fixtures.git] / lib / DBIx / Class / Fixtures.pm

diff --git a/lib/DBIx/Class/Fixtures.pm b/lib/DBIx/Class/Fixtures.pm
index d3ef790..9f9074a 100644 (file)
--- a/lib/DBIx/Class/Fixtures.pm
+++ b/lib/DBIx/Class/Fixtures.pm
@@ -23,7 +23,7 @@ our $namespace_counter = 0;
 __PACKAGE__->mk_group_accessors( 'simple' => qw/config_dir
     _inherited_attributes debug schema_class dumped_objects config_attrs/);
 
-our $VERSION = '1.001026';
+our $VERSION = '1.001_029';
 
 $VERSION = eval $VERSION;
 
@@ -602,7 +602,7 @@ sub dump {
       do {
         #read config
         my $config_file = io->catfile($self->config_dir, $params->{config});
-        $self->load_config_file($config_file);
+        $self->load_config_file("$config_file");
       };
   } elsif ($params->{all}) {
     my %excludes = map {$_=>1} @{$params->{excludes}||[]};
@@ -628,7 +628,7 @@ sub dump {
   }
 
   $self->msg("generating  fixtures");
-  my $tmp_output_dir = io->dir(tempdir);;
+  my $tmp_output_dir = io->dir(tempdir);
 
   if (-e "$tmp_output_dir") {
     $self->msg("- clearing existing $tmp_output_dir");
@@ -804,11 +804,11 @@ sub dump_object {
         },
         catfile => sub {
           my ($self, @args) = @_;
-          io->catfile(@args);
+          "".io->catfile(@args);
         },
         catdir => sub {
           my ($self, @args) = @_;
-          io->catdir(@args);
+          "".io->catdir(@args);
         },
       };
 
@@ -898,6 +898,7 @@ sub dump_object {
 
     # do the actual dumping
     my $serialized = Dump(\%ds)->Out();
+
     $file->print($serialized);
   }
 
@@ -1255,7 +1256,7 @@ sub populate {
       return DBIx::Class::Exception->throw('connection details must be an arrayref');
     }
     $schema = $self->_generate_schema({
-      ddl => $ddl_file,
+      ddl => "$ddl_file",
       connection_details => delete $params->{connection_details},
       %{$params}
     });
@@ -1270,7 +1271,6 @@ sub populate {
 
   $self->msg("\nimporting fixtures");
   my $tmp_fixture_dir = io->dir(tempdir());
-  my $version_file = io->file($fixture_dir, '_dumper_version');
   my $config_set_path = io->file($fixture_dir, '_config_set');
   my $config_set = -e "$config_set_path" ? do { my $VAR1; eval($config_set_path->slurp); $VAR1 } : '';
 
@@ -1320,9 +1320,6 @@ sub populate {
       @{$config_set->{sets}}
   }
 
-#  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;
@@ -1358,7 +1355,8 @@ sub populate {
 
   $schema->storage->txn_do(sub {
     $schema->storage->with_deferred_fk_checks(sub {
-      foreach my $source (sort $schema->sources) {
+      my @sorted_source_names = $self->_get_sorted_sources( $schema );
+      foreach my $source (@sorted_source_names) {
         $self->msg("- adding " . $source);
         my $rs = $schema->resultset($source);
         my $source_dir = io->catdir($tmp_fixture_dir, $self->_name_for_source($rs->result_source));
@@ -1426,6 +1424,92 @@ sub populate {
   return 1;
 }
 
+# the overall logic is modified from SQL::Translator::Parser::DBIx::Class->parse
+sub _get_sorted_sources {
+  my ( $self, $dbicschema ) = @_;
+
+
+  my %table_monikers = map { $_ => 1 } $dbicschema->sources;
+
+  my %tables;
+  foreach my $moniker (sort keys %table_monikers) {
+    my $source = $dbicschema->source($moniker);
+
+    my $table_name = $source->name;
+    my @primary = $source->primary_columns;
+    my @rels = $source->relationships();
+
+    my %created_FK_rels;
+    foreach my $rel (sort @rels) {
+      my $rel_info = $source->relationship_info($rel);
+
+      # Ignore any rel cond that isn't a straight hash
+      next unless ref $rel_info->{cond} eq 'HASH';
+
+      my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} keys(%{$rel_info->{cond}});
+
+      # determine if this relationship is a self.fk => foreign.pk (i.e. belongs_to)
+      my $fk_constraint;
+      if ( exists $rel_info->{attrs}{is_foreign_key_constraint} ) {
+        $fk_constraint = $rel_info->{attrs}{is_foreign_key_constraint};
+      } elsif ( $rel_info->{attrs}{accessor}
+          && $rel_info->{attrs}{accessor} eq 'multi' ) {
+        $fk_constraint = 0;
+      } else {
+        $fk_constraint = not $source->_compare_relationship_keys(\@keys, \@primary);
+      }
+
+      # Dont add a relation if its not constraining
+      next unless $fk_constraint;
+
+      my $rel_table = $source->related_source($rel)->source_name;
+      # Make sure we don't create the same relation twice
+      my $key_test = join("\x00", sort @keys);
+      next if $created_FK_rels{$rel_table}->{$key_test};
+
+      if (scalar(@keys)) {
+        $created_FK_rels{$rel_table}->{$key_test} = 1;
+
+        # calculate dependencies: do not consider deferrable constraints and
+        # self-references for dependency calculations
+        if (! $rel_info->{attrs}{is_deferrable} and $rel_table ne $table_name) {
+          $tables{$moniker}{$rel_table}++;
+        }
+      }
+    }
+    $tables{$moniker} = {} unless exists $tables{$moniker};
+  }
+
+  # resolve entire dep tree
+  my $dependencies = {
+    map { $_ => _resolve_deps ($_, \%tables) } (keys %tables)
+  };
+
+  # return the sorted result
+  return sort {
+    keys %{$dependencies->{$a} || {} } <=> keys %{ $dependencies->{$b} || {} }
+      ||
+    $a cmp $b
+  } (keys %tables);
+}
+
+sub _resolve_deps {
+  my ( $question, $answers, $seen ) = @_;
+  my $ret = {};
+  $seen ||= {};
+
+  my %seen = map { $_ => $seen->{$_} + 1 } ( keys %$seen );
+  $seen{$question} = 1;
+
+  for my $dep (keys %{ $answers->{$question} }) {
+    return {} if $seen->{$dep};
+    my $subdeps = _resolve_deps( $dep, $answers, \%seen );
+    $ret->{$_} += $subdeps->{$_} for ( keys %$subdeps );
+    ++$ret->{$dep};
+  }
+  return $ret;
+}
+
 sub do_post_ddl {
   my ($self, $params) = @_;