X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FParser%2FDBIx%2FClass.pm;h=93a39a05472ab8385e353a4a7f0df048350ae77b;hb=51b31bbe7d3359237fd2eb5e1f4aadb133578f25;hp=ca25aa21d8f48827ae82651a80bd369d1b3b14b2;hpb=9780718f9c36738245f90b1f036998c3b076cffc;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/SQL/Translator/Parser/DBIx/Class.pm b/lib/SQL/Translator/Parser/DBIx/Class.pm index ca25aa2..93a39a0 100644 --- a/lib/SQL/Translator/Parser/DBIx/Class.pm +++ b/lib/SQL/Translator/Parser/DBIx/Class.pm @@ -15,8 +15,10 @@ $DEBUG = 0 unless defined $DEBUG; use Exporter; use SQL::Translator::Utils qw(debug normalize_name); use Carp::Clan qw/^SQL::Translator|^DBIx::Class|^Try::Tiny/; -use Scalar::Util (); +use Scalar::Util 'weaken'; use Try::Tiny; +use Devel::Dwarn; +use namespace::clean; use base qw(Exporter); @@ -34,7 +36,7 @@ use base qw(Exporter); sub parse { # this is a hack to prevent schema leaks due to a retarded SQLT implementation # DO NOT REMOVE (until SQLT2 is out, the all of this will be rewritten anyway) - Scalar::Util::weaken ($_[1]) if ref ($_[1]); + weaken $_[1] if ref ($_[1]); my ($tr, $data) = @_; my $args = $tr->parser_args; @@ -64,7 +66,7 @@ sub parse { $dbicschema->throw_exception ("'sources' parameter must be an array or hash ref") unless( $ref eq 'ARRAY' || ref eq 'HASH' ); - # limit monikers to those specified in + # limit monikers to those specified in my $sources; if ($ref eq 'ARRAY') { $sources->{$_} = 1 for (@$limit_sources); @@ -170,7 +172,7 @@ sub parse { # 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}}); + 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 @refkeys = map {/^\w+\.(\w+)$/} @cond; @@ -269,6 +271,7 @@ sub parse { my $dependencies = { map { $_ => _resolve_deps ($_, \%tables) } (keys %tables) }; + for my $table (sort { keys %{$dependencies->{$a} || {} } <=> keys %{ $dependencies->{$b} || {} } @@ -297,9 +300,29 @@ EOW } my %views; - foreach my $moniker (sort keys %view_monikers) + my @views = map { $dbicschema->source($_) } keys %view_monikers; + my $view_dependencies; + + ### This is a loop instead of a map because + ### passing an object to the sub failed--gave + ### $view->name instead of the $view! + + for my $view (@views) { + $view_dependencies->{ $view->name } = + _resolve_view_deps ( { view => $view }, \%view_monikers ); + } + + my @view_sources = + sort { + keys %{ $view_dependencies->{ $a->name } || {} } <=> + keys %{ $view_dependencies->{ $b->name } || {} } + || $a->source_name cmp $b->source_name + } + map { $dbicschema->source($_) } + keys %view_monikers; + + foreach my $source (@view_sources) { - my $source = $dbicschema->source($moniker); my $view_name = $source->name; # FIXME - this isn't the right way to do it, but sqlt does not @@ -367,6 +390,33 @@ sub _resolve_deps { return $ret; } +sub _resolve_view_deps { + my ( $view0, $monikers, $seen ) = @_; + my $view = $view0->{view}; + my $ret = {}; + $seen ||= {}; + + # copy and bump all deps by one (so we can reconstruct the chain) + my %seen = map { $_ => $seen->{$_} + 1 } ( keys %$seen ); + $seen{ $view->source_name } = 1; + + for my $dep ( keys %{ $view->{deploy_depends_on} } ) { + if ( $seen->{$dep} ) { + return {}; + } + my ($new_source_name) = + grep { $view->schema->source($_)->name eq $dep } + @{ [ $view->schema->sources ] }; + my $subdeps = _resolve_view_deps( + { view => $view->schema->source($new_source_name) }, + $monikers, \%seen, ); + $ret->{$_} += $subdeps->{$_} for ( keys %$subdeps ); + + ++$ret->{$dep}; + } + return $ret; +} + 1; =head1 NAME