From: Tom Bloor <t.bloor@shadowcat.co.uk>
Date: Wed, 20 May 2015 23:29:40 +0000 (+0000)
Subject: re-thought the logic, basically stripped the SQLT logic of anything not needed
X-Git-Tag: v1.001_031~2^2~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Fixtures.git;a=commitdiff_plain;h=89f126ea6c0e564518d8d85ec605e630e1d528e3

re-thought the logic, basically stripped the SQLT logic of anything not needed
---

diff --git a/lib/DBIx/Class/Fixtures.pmc b/lib/DBIx/Class/Fixtures.pmc
index 951b884..a6496d7 100644
--- a/lib/DBIx/Class/Fixtures.pmc
+++ b/lib/DBIx/Class/Fixtures.pmc
@@ -1354,110 +1354,7 @@ sub populate {
 
   $schema->storage->txn_do(sub {
     $schema->storage->with_deferred_fk_checks(sub {
-      use SQL::Translator;
-      my $sqlt = SQL::Translator->new(
-        parser => 'SQL::Translator::Parser::DBIx::Class',
-        parser_args => {
-          dbic_schema => $schema,
-        },
-      );
-      $sqlt->translate;
-      my $sqlt_schema = $sqlt->schema;
-      my %table_order = map +($_->name => $_->order - 1), $sqlt_schema->get_tables;
-      {
-        # testing stuff
-        my @testing_sorted_sn = sort $schema->sources;
-        my %sources_deps = map { $_ => {} } @testing_sorted_sn;
-        for my $testing_source ( @testing_sorted_sn ) {
-          ::Dwarn "Source: " . $testing_source;
-          my @testing_relationships = $schema->source( $testing_source )->relationships;
-          ::Dwarn "Relationships: " . join (', ', @testing_relationships);
-          if ( scalar @testing_relationships ) {
-            for my $testing_rel ( @testing_relationships ) {
-              my $rel_info = $schema->source( $testing_source )->relationship_info( $testing_rel );
-              ::Dwarn $rel_info;
-
-              if (
-                exists( $rel_info->{ attrs }->{ 'is_foreign_key_constraint' } )
-                && $rel_info->{ attrs }->{ 'is_foreign_key_constraint' }
-                && ! $rel_info->{ attrs }->{ 'is_deferrable' }
-                && ! ( $rel_info->{attrs}{accessor} eq 'multi' )
-              ) {
-                my $dep = $schema->source( $testing_source )->related_source( $testing_rel )->source_name;
-                $sources_deps{ $testing_source }->{ $dep } = $sources_deps{ $dep };
-              }
-            }
-            # set to 0 if there are no deps
-            $sources_deps{ $testing_source } = 0 unless scalar keys $sources_deps{ $testing_source };
-          }
-          ::Dwarn "";
-          ::Dwarn "";
-        }
-        ::Dwarn \%sources_deps;
-
-        for my $source ( keys %sources_deps ) {
-          my $tally = 0;
-          if ( ref( $sources_deps{ $source } ) eq "HASH" ) {
-          for my $dep ( keys %{ $sources_deps{ $source } } ) {
-            my $val = $sources_deps{ $source }->{ $dep };
-            if ( ( ref( $val ) eq 'SCALAR' ) && ( $tally == $val ) ) {
-              $tally++;
-            } else {
-              $tally = 99;
-            }
-          }
-          }
-          $sources_deps{ $source } = $tally;
-        }
-        ::Dwarn \%sources_deps;
-
-
-#        my @test_names = keys %sources_deps;
-
-#        my @test_sorted = sort {
-#         ( $sources_deps{ $a }->{ $b } || 0 )
-#         cmp
-#         ( $sources_deps{ $b }->{ $a } || 0 )
-#        } @test_names;
-
-#        ::Dwarn \@test_names;
-#        ::Dwarn \@test_sorted;
-
-#        ::Dwarn \%sources_deps;
-
-#        my @test_sources = @test_sorted;
-#        my @test_output;
-
-
-
-#        while ( @test_sources ) {
-#          my $source = shift @test_sources;
-#          ::Dwarn "checking: $source";
-#          my $deps = keys $sources_deps{ $source };
-#          if ( $deps ) {
-#            push @test_sources, $source;
-#            ::Dwarn "pushing: $source";
-#          } else {
-#            for ( keys %sources_deps ) {
-#              delete $sources_deps{ $_ }->{ $source };
-#              ::Dwarn "deleting: $source from $_";
-#            }
-#            push @test_output, $source;
-#            ::Dwarn "Adding $source to output";
-#          }
-#        }
-
-#        ::Dwarn \@test_output;
-
-      }
-      my @sorted_source_names;
-      for my $source ( $schema->sources ) {
-        next unless $source; # somehow theres an undef one
-        my $table = $schema->source( $source )->name;
-        $sorted_source_names[ $table_order{ $table } ] = $source;
-      }
-      ::Dwarn "Sorted Source Names\n";
-      ::Dwarn \@sorted_source_names;
+      my @sorted_source_names = $self->_get_sorted_sources( $schema );
       foreach my $source (@sorted_source_names) {
         $self->msg("- adding " . $source);
         my $rs = $schema->resultset($source);
@@ -1526,6 +1423,93 @@ 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 );
+    ::Dwarn $subdeps if $dep eq 'downloads';
+    $ret->{$_} += $subdeps->{$_} for ( keys %$subdeps );
+    ++$ret->{$dep};
+  }
+  return $ret;
+}
+
 sub do_post_ddl {
   my ($self, $params) = @_;