return $schema;
}
+sub source_tree {
+ my $self = shift;
+ my $args = shift;
+
+ my %limit_sources = do {
+ my $l = $args->{limit_sources};
+ my $ref = ref $l;
+
+ $ref eq 'HASH' ?
+ %$l
+ : map { $_ => 1} @$l
+ };
+
+ my %table_monikers =
+ map { $_ => 1 }
+ grep { $self->source($_)->isa('DBIx::Class::ResultSource::Table') }
+ grep { !$limit_sources{$_} }
+ $self->sources;
+
+ my %tables;
+ foreach my $moniker (sort keys %table_monikers) {
+ my $source = $self->source($moniker);
+ my $table_name = $source->name;
+
+ # FIXME - this isn't the right way to do it, but sqlt does not
+ # support quoting properly to be signaled about this
+ $table_name = $$table_name if ref $table_name eq 'SCALAR';
+
+ # It's possible to have multiple DBIC sources using the same table
+ next if $tables{$table_name};
+
+ $tables{$table_name}{source} = $source;
+
+ foreach my $rel (sort $source->relationships) {
+ my $rel_info = $source->relationship_info($rel);
+
+ # FIXME - we can probably do better, at least check if it's a
+ # coderef that returns a plain hash w/ fk-fk
+ # Ignore any rel cond that isn't a straight hash
+ next unless ref $rel_info->{cond} eq 'HASH';
+
+ my $relsource = try { $source->related_source($rel) };
+ next unless $relsource;
+
+ # related sources might be excluded via a {sources} filter or might be views
+ next unless exists $table_monikers{$relsource->source_name};
+
+ my $rel_table = $relsource->name;
+
+ # FIXME - this isn't the right way to do it, but sqlt does not
+ # support quoting properly to be signaled about this
+ $rel_table = $$rel_table if ref $rel_table eq 'SCALAR';
+
+ # Force the order of @cond to match the order of ->add_columns
+ my $idx;
+ my %other_columns_idx = map {'foreign.'.$_ => ++$idx } $relsource->columns;
+ my @cond = sort { $other_columns_idx{$a} cmp $other_columns_idx{$b} } keys(%{$rel_info->{cond}});
+
+ # Get the key information, mapping off the foreign/self markers
+ my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
+
+ # determine if this relationship is a self.fk => foreign.pk (i.e. belongs_to)
+ my $fk_constraint;
+
+ #first it can be specified explicitly
+ if ( exists $rel_info->{attrs}{is_foreign_key_constraint} ) {
+ $fk_constraint = $rel_info->{attrs}{is_foreign_key_constraint};
+ }
+ # it can not be multi
+ elsif ( $rel_info->{attrs}{accessor}
+ && $rel_info->{attrs}{accessor} eq 'multi' ) {
+ $fk_constraint = 0;
+ }
+ # if indeed single, check if all self.columns are our primary keys.
+ # this is supposed to indicate a has_one/might_have...
+ # where's the introspection!!?? :)
+ else {
+ $fk_constraint = not $source->_compare_relationship_keys(
+ \@keys, [$source->primary_columns]);
+ }
+
+ $tables{$table_name}{foreign_table_deps}{$rel_table}++
+ if $fk_constraint && @keys
+ # calculate dependencies: do not consider deferrable constraints and
+ # self-references for dependency calculations
+ && !$rel_info->{attrs}{is_deferrable}
+ && $rel_table && $rel_table ne $table_name
+
+ }
+ }
+
+ return {
+ map { $_ => $self->_resolve_deps ($_, \%tables) } (keys %tables)
+ }
+}
+
+sub _resolve_deps {
+ my ( $self, $question, $answers, $seen ) = @_;
+ my $ret = {};
+ $seen ||= {};
+ my @deps;
+
+ # copy and bump all deps by one (so we can reconstruct the chain)
+ my %seen = map { $_ => $seen->{$_} + 1 } ( keys %$seen );
+ if ( blessed($question)
+ && $question->isa('DBIx::Class::ResultSource::View') )
+ {
+ $seen{ $question->result_class } = 1;
+ @deps = keys %{ $question->{deploy_depends_on} };
+ }
+ else {
+ $seen{$question} = 1;
+ @deps = keys %{ $answers->{$question}{foreign_table_deps} };
+ }
+
+ for my $dep (@deps) {
+ if ( $seen->{$dep} ) {
+ return {};
+ }
+ my $next_dep;
+
+ if ( blessed($question)
+ && $question->isa('DBIx::Class::ResultSource::View') )
+ {
+ no warnings 'uninitialized';
+ my ($next_dep_source_name) =
+ grep {
+ $question->schema->source($_)->result_class eq $dep
+ && !( $question->schema->source($_)
+ ->isa('DBIx::Class::ResultSource::Table') )
+ } @{ [ $question->schema->sources ] };
+ return {} unless $next_dep_source_name;
+ $next_dep = $question->schema->source($next_dep_source_name);
+ }
+ else {
+ $next_dep = $dep;
+ }
+ my $subdeps = $self->_resolve_deps( $next_dep, $answers, \%seen );
+ $ret->{$_} += $subdeps->{$_} for ( keys %$subdeps );
+ ++$ret->{$dep};
+ }
+ return $ret;
+}
+
1;
=head1 AUTHORS
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+use lib qw(t/lib);
+use DBICTest;
+
+my $schema = DBICTest->init_schema( no_connect => 1, no_deploy => 1 );
+
+is_deeply($schema->source_tree, {
+ " ( SELECT a.*, cd.cdid AS cdid, cd.title AS title, cd.year AS year\n FROM artist a\n JOIN cd ON cd.artist = a.artistid\n WHERE cd.year = ?)\n" => {},
+ artist => {},
+ artist_undirected_map => {
+ artist => 1
+ },
+ artwork_to_artist => {
+ artist => 1,
+ cd => 1,
+ cd_artwork => 1,
+ genre => 1,
+ track => 1
+ },
+ bindtype_test => {},
+ bookmark => {
+ link => 1
+ },
+ books => {
+ owners => 1
+ },
+ cd => {
+ genre => 1,
+ track => 1
+ },
+ cd_artwork => {
+ cd => 1,
+ genre => 1,
+ track => 1
+ },
+ cd_to_producer => {
+ cd => 1,
+ genre => 1,
+ producer => 1,
+ track => 1
+ },
+ collection => {},
+ collection_object => {
+ collection => 1,
+ typed_object => 1
+ },
+ dummy => {},
+ employee => {
+ encoded => 1
+ },
+ encoded => {},
+ event => {},
+ forceforeign => {
+ artist => 1
+ },
+ fourkeys => {},
+ fourkeys_to_twokeys => {
+ artist => 1,
+ cd => 1,
+ fourkeys => 1,
+ genre => 1,
+ track => 1,
+ twokeys => 1
+ },
+ genre => {},
+ images => {
+ cd => 1,
+ cd_artwork => 1,
+ genre => 1,
+ track => 1
+ },
+ liner_notes => {
+ cd => 1,
+ genre => 1,
+ track => 1
+ },
+ link => {},
+ lyric_versions => {
+ cd => 1,
+ lyrics => 1,
+ track => 1
+ },
+ lyrics => {
+ cd => 1,
+ track => 1
+ },
+ money_test => {},
+ noprimarykey => {},
+ onekey => {},
+ owners => {},
+ producer => {},
+ self_ref => {},
+ self_ref_alias => {
+ self_ref => 1
+ },
+ sequence_test => {},
+ serialized => {},
+ tags => {
+ cd => 1,
+ genre => 1,
+ track => 1
+ },
+ timestamp_primary_key_test => {},
+ track => {
+ cd => 1
+ },
+ treelike => {},
+ twokeys => {
+ artist => 1,
+ cd => 1,
+ genre => 1,
+ track => 1
+ },
+ twokeytreelike => {},
+ typed_object => {},
+}, 'got correct source tree');
+
+is_deeply($schema->source_tree({ limit_sources => ['TwoKeys'] }), {
+ " ( SELECT a.*, cd.cdid AS cdid, cd.title AS title, cd.year AS year\n FROM artist a\n JOIN cd ON cd.artist = a.artistid\n WHERE cd.year = ?)\n" => {},
+ artist => {},
+ artist_undirected_map => {
+ artist => 1
+ },
+ artwork_to_artist => {
+ artist => 1,
+ cd => 1,
+ cd_artwork => 1,
+ genre => 1,
+ track => 1
+ },
+ bindtype_test => {},
+ bookmark => {
+ link => 1
+ },
+ books => {
+ owners => 1
+ },
+ cd => {
+ genre => 1,
+ track => 1
+ },
+ cd_artwork => {
+ cd => 1,
+ genre => 1,
+ track => 1
+ },
+ cd_to_producer => {
+ cd => 1,
+ genre => 1,
+ producer => 1,
+ track => 1
+ },
+ collection => {},
+ collection_object => {
+ collection => 1,
+ typed_object => 1
+ },
+ dummy => {},
+ employee => {
+ encoded => 1
+ },
+ encoded => {},
+ event => {},
+ forceforeign => {
+ artist => 1
+ },
+ fourkeys => {},
+ fourkeys_to_twokeys => {
+ fourkeys => 1
+ },
+ genre => {},
+ images => {
+ cd => 1,
+ cd_artwork => 1,
+ genre => 1,
+ track => 1
+ },
+ liner_notes => {
+ cd => 1,
+ genre => 1,
+ track => 1
+ },
+ link => {},
+ lyric_versions => {
+ cd => 1,
+ lyrics => 1,
+ track => 1
+ },
+ lyrics => {
+ cd => 1,
+ track => 1
+ },
+ money_test => {},
+ noprimarykey => {},
+ onekey => {},
+ owners => {},
+ producer => {},
+ self_ref => {},
+ self_ref_alias => {
+ self_ref => 1
+ },
+ sequence_test => {},
+ serialized => {},
+ tags => {
+ cd => 1,
+ genre => 1,
+ track => 1
+ },
+ timestamp_primary_key_test => {},
+ track => {
+ cd => 1
+ },
+ treelike => {},
+ twokeytreelike => {},
+ typed_object => {}
+}, 'got correct source tree with limit_sources => [ ... ]');
+
+is_deeply($schema->source_tree({ limit_sources => { TwoKeys => 1 } }), {
+ " ( SELECT a.*, cd.cdid AS cdid, cd.title AS title, cd.year AS year\n FROM artist a\n JOIN cd ON cd.artist = a.artistid\n WHERE cd.year = ?)\n" => {},
+ artist => {},
+ artist_undirected_map => {
+ artist => 1
+ },
+ artwork_to_artist => {
+ artist => 1,
+ cd => 1,
+ cd_artwork => 1,
+ genre => 1,
+ track => 1
+ },
+ bindtype_test => {},
+ bookmark => {
+ link => 1
+ },
+ books => {
+ owners => 1
+ },
+ cd => {
+ genre => 1,
+ track => 1
+ },
+ cd_artwork => {
+ cd => 1,
+ genre => 1,
+ track => 1
+ },
+ cd_to_producer => {
+ cd => 1,
+ genre => 1,
+ producer => 1,
+ track => 1
+ },
+ collection => {},
+ collection_object => {
+ collection => 1,
+ typed_object => 1
+ },
+ dummy => {},
+ employee => {
+ encoded => 1
+ },
+ encoded => {},
+ event => {},
+ forceforeign => {
+ artist => 1
+ },
+ fourkeys => {},
+ fourkeys_to_twokeys => {
+ fourkeys => 1
+ },
+ genre => {},
+ images => {
+ cd => 1,
+ cd_artwork => 1,
+ genre => 1,
+ track => 1
+ },
+ liner_notes => {
+ cd => 1,
+ genre => 1,
+ track => 1
+ },
+ link => {},
+ lyric_versions => {
+ cd => 1,
+ lyrics => 1,
+ track => 1
+ },
+ lyrics => {
+ cd => 1,
+ track => 1
+ },
+ money_test => {},
+ noprimarykey => {},
+ onekey => {},
+ owners => {},
+ producer => {},
+ self_ref => {},
+ self_ref_alias => {
+ self_ref => 1
+ },
+ sequence_test => {},
+ serialized => {},
+ tags => {
+ cd => 1,
+ genre => 1,
+ track => 1
+ },
+ timestamp_primary_key_test => {},
+ track => {
+ cd => 1
+ },
+ treelike => {},
+ twokeytreelike => {},
+ typed_object => {}
+}, 'got correct source tree with limit_sources => { ... }');
+
+# We probably also want a "collapsed" tree
+
+done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff