From: Peter Rabbitson Date: Mon, 28 Sep 2015 13:34:12 +0000 (+0200) Subject: A little more golfing - this time ::DBIHacks::_resolve_column_info X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=229401a04e99e27e256fdcd24b3c34087c9c2bc1;p=dbsrgits%2FDBIx-Class-Historic.git A little more golfing - this time ::DBIHacks::_resolve_column_info More surprising stuff showing up on the profiles... --- diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm index c80ffc4..a123f41 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -13,7 +13,6 @@ use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION'; use SQL::Abstract 'is_literal_value'; use Devel::GlobalDestruction; use Try::Tiny; -use List::Util 'first'; use Scalar::Util qw/blessed weaken isweak/; use namespace::clean; @@ -476,12 +475,12 @@ sub columns_info { my $colinfo = $self->_columns; if ( - first { ! $_->{data_type} } values %$colinfo - and ! $self->{_columns_info_loaded} and $self->column_info_from_storage and + grep { ! $_->{data_type} } values %$colinfo + and my $stor = try { $self->storage } ) { $self->{_columns_info_loaded}++; @@ -803,7 +802,7 @@ sub add_unique_constraints { my $self = shift; my @constraints = @_; - if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) { + if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) { # with constraint name while (my ($name, $constraint) = splice @constraints, 0, 2) { $self->add_unique_constraint($name => $constraint); @@ -1708,9 +1707,11 @@ sub _resolve_join { , -join_path => [@$jpath, { $join => $as } ], -is_single => ( - (! $rel_info->{attrs}{accessor}) + ! $rel_info->{attrs}{accessor} + or + $rel_info->{attrs}{accessor} eq 'single' or - first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/) + $rel_info->{attrs}{accessor} eq 'filter' ), -alias => $as, -relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1, diff --git a/lib/DBIx/Class/Storage/DBIHacks.pm b/lib/DBIx/Class/Storage/DBIHacks.pm index 937f771..7da10cc 100644 --- a/lib/DBIx/Class/Storage/DBIHacks.pm +++ b/lib/DBIx/Class/Storage/DBIHacks.pm @@ -719,53 +719,63 @@ sub _resolve_column_info { return {} if $colnames and ! @$colnames; - my $alias2src = $self->_resolve_ident_sources($ident); + my $sources = $self->_resolve_ident_sources($ident); + + $_ = { rsrc => $_, colinfos => $_->columns_info } + for values %$sources; my (%seen_cols, @auto_colnames); # compile a global list of column names, to be able to properly # disambiguate unqualified column names (if at all possible) - for my $alias (keys %$alias2src) { - my $rsrc = $alias2src->{$alias}; - for my $colname ($rsrc->columns) { - push @{$seen_cols{$colname}}, $alias; - push @auto_colnames, "$alias.$colname" unless $colnames; - } + for my $alias (keys %$sources) { + ( + ++$seen_cols{$_}{$alias} + and + ! $colnames + and + push @auto_colnames, "$alias.$_" + ) for keys %{ $sources->{$alias}{colinfos} }; } $colnames ||= [ @auto_colnames, - grep { @{$seen_cols{$_}} == 1 } (keys %seen_cols), + ( grep { keys %{$seen_cols{$_}} == 1 } keys %seen_cols ), ]; - my (%return, $colinfos); - foreach my $col (@$colnames) { - my ($source_alias, $colname) = $col =~ m/^ (?: ([^\.]+) \. )? (.+) $/x; - - # if the column was seen exactly once - we know which rsrc it came from - $source_alias ||= $seen_cols{$colname}[0] - if ($seen_cols{$colname} and @{$seen_cols{$colname}} == 1); + my %return; + for (@$colnames) { + my ($colname, $source_alias) = reverse split /\./, $_; - next unless $source_alias; + my $assumed_alias = + $source_alias + || + # if the column was seen exactly once - we know which rsrc it came from + ( + $seen_cols{$colname} + and + keys %{$seen_cols{$colname}} == 1 + and + ( %{$seen_cols{$colname}} )[0] + ) + || + next + ; - my $rsrc = $alias2src->{$source_alias} - or next; + $self->throw_exception( + "No such column '$colname' on source " . $sources->{$assumed_alias}{rsrc}->source_name + ) unless $seen_cols{$colname}{$assumed_alias}; - $return{$col} = { - %{ - ( $colinfos->{$source_alias} ||= $rsrc->columns_info )->{$colname} - || - $self->throw_exception( - "No such column '$colname' on source " . $rsrc->source_name - ); - }, - -result_source => $rsrc, - -source_alias => $source_alias, - -fq_colname => $col eq $colname ? "$source_alias.$col" : $col, + $return{$_} = { + %{ $sources->{$assumed_alias}{colinfos}{$colname} }, + -result_source => $sources->{$assumed_alias}{rsrc}, + -source_alias => $assumed_alias, + -fq_colname => "$assumed_alias.$colname", -colname => $colname, }; - $return{"$source_alias.$colname"} = $return{$col} if $col eq $colname; + $return{"$assumed_alias.$colname"} = $return{$_} + unless $source_alias; } return \%return;