From: Daniel Westermann-Clark Date: Wed, 19 Apr 2006 15:19:51 +0000 (+0000) Subject: Merge 'find_changes' into 'DBIx-Class-current' X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9387c9042568a6c4dcc8e197f0000e7c7c4bbf13;p=dbsrgits%2FDBIx-Class-Historic.git Merge 'find_changes' into 'DBIx-Class-current' - add update_or_create_related to Relationship::Base - add find_or_new to ResultSet/ResultSetProxy and find_or_new_related to Relationship::Base - add accessors for unique constraint names and coulums to ResultSource/ResultSourceProxy - rework ResultSet::find() to search unique constraints - CDBICompat: modify retrieve to fix column casing when ColumnCase is loaded - CDBICompat: override find_or_create to fix column casing when ColumnCase is loaded --- 9387c9042568a6c4dcc8e197f0000e7c7c4bbf13 diff --cc Changes index ab770fa,5255e26..7d02195 --- a/Changes +++ b/Changes @@@ -3,14 -3,18 +3,24 @@@ Revision history for DBIx::Clas - added remove_column(s) to ResultSource/ResultSourceProxy - added add_column alias to ResultSourceProxy - added source_name to ResultSource - - load_classes now uses source_name and sets it if necessary + - load_classes now uses source_name and sets it if necessary + - add update_or_create_related to Relationship::Base + - add find_or_new to ResultSet/ResultSetProxy and find_or_new_related + to Relationship::Base + - add accessors for unique constraint names and coulums to + ResultSource/ResultSourceProxy + - rework ResultSet::find() to search unique constraints ++ - CDBICompat: modify retrieve to fix column casing when ColumnCase is ++ loaded ++ - CDBICompat: override find_or_create to fix column casing when ++ ColumnCase is loaded 0.06002 + - grab $self->dbh once per function in Storage::DBI + - nuke ResultSource caching of ->resultset for consistency reasons - fix for -and conditions when updating or deleting on a ResultSet -0.06001 +0.06001 2006-04-08 21:48:43 - minor fix to update in case of undefined rels - fixes for cascade delete - substantial improvements and fixes to deploy diff --cc lib/DBIx/Class/CDBICompat/ColumnCase.pm index 9d0c96f,9d0c96f..9be24ff --- a/lib/DBIx/Class/CDBICompat/ColumnCase.pm +++ b/lib/DBIx/Class/CDBICompat/ColumnCase.pm @@@ -66,6 -66,6 +66,19 @@@ sub find_column return $class->next::method(lc($col)); } ++# _build_query ++# ++# Build a query hash for find, et al. Overrides Retrieve::_build_query. ++ ++sub _build_query { ++ my ($self, $query) = @_; ++ ++ my %new_query; ++ $new_query{lc $_} = $query->{$_} for keys %$query; ++ ++ return \%new_query; ++} ++ sub _mk_group_accessors { my ($class, $type, $group, @fields) = @_; #warn join(', ', map { ref $_ ? (@$_) : ($_) } @fields); diff --cc lib/DBIx/Class/CDBICompat/Retrieve.pm index 899ed69,899ed69..1186ae4 --- a/lib/DBIx/Class/CDBICompat/Retrieve.pm +++ b/lib/DBIx/Class/CDBICompat/Retrieve.pm @@@ -5,9 -5,9 +5,44 @@@ use strict use warnings FATAL => 'all'; --sub retrieve { -- die "No args to retrieve" unless @_ > 1; -- shift->find(@_); ++sub retrieve { ++ my $self = shift; ++ die "No args to retrieve" unless @_ > 0; ++ ++ my @cols = $self->primary_columns; ++ ++ my $query; ++ if (ref $_[0] eq 'HASH') { ++ $query = { %{$_[0]} }; ++ } ++ elsif (@_ == @cols) { ++ $query = {}; ++ @{$query}{@cols} = @_; ++ } ++ else { ++ $query = {@_}; ++ } ++ ++ $query = $self->_build_query($query); ++ $self->find($query); ++} ++ ++sub find_or_create { ++ my $self = shift; ++ my $query = ref $_[0] eq 'HASH' ? shift : {@_}; ++ ++ $query = $self->_build_query($query); ++ $self->next::method($query); ++} ++ ++# _build_query ++# ++# Build a query hash. Defaults to a no-op; ColumnCase overrides. ++ ++sub _build_query { ++ my ($self, $query) = @_; ++ ++ return $query; } sub retrieve_from_sql { diff --cc lib/DBIx/Class/ResultSet.pm index f2d0fd9,7679e11..56a55d4 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@@ -290,44 -304,82 +302,78 @@@ L 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {}); + my $self = shift; + my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); + + # Parse out a hash from input + my @cols = exists $attrs->{key} + ? $self->result_source->unique_constraint_columns($attrs->{key}) + : $self->result_source->primary_columns; - my @cols = $self->result_source->primary_columns; - if (exists $attrs->{key}) { - my %uniq = $self->result_source->unique_constraints; - my %hash; ++ my $hash; + if (ref $_[0] eq 'HASH') { - %hash = %{ $_[0] }; ++ $hash = { %{$_[0]} }; + } + elsif (@_ == @cols) { - @hash{@cols} = @_; ++ $hash = {}; ++ @{$hash}{@cols} = @_; + } + else { - # Hack for CDBI queries - %hash = @_; + $self->throw_exception( - "Unknown key $attrs->{key} on '" . $self->result_source->name . "'" - ) unless exists $uniq{$attrs->{key}}; - @cols = @{ $uniq{$attrs->{key}} }; ++ "Arguments to find must be a hashref or match the number of columns in the " ++ . exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key" ++ ); } - #use Data::Dumper; warn Dumper($attrs, @vals, @cols); + + # Check the hash we just parsed against our source's unique constraints + my @constraint_names = exists $attrs->{key} + ? ($attrs->{key}) + : $self->result_source->unique_constraint_names; $self->throw_exception( "Can't find unless a primary key or unique constraint is defined" - ) unless @cols; - - my $query; - if (ref $vals[0] eq 'HASH') { - $query = { %{$vals[0]} }; - } elsif (@cols == @vals) { - $query = {}; - @{$query}{@cols} = @vals; - } else { - $query = {@vals}; - } - foreach my $key (grep { ! m/\./ } keys %$query) { - $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key}; + ) unless @constraint_names; + - my @unique_hashes; ++ my @unique_queries; + foreach my $name (@constraint_names) { + my @unique_cols = $self->result_source->unique_constraint_columns($name); - my %unique_hash = $self->_unique_hash(\%hash, \@unique_cols); ++ my $unique_query = $self->_build_unique_query($hash, \@unique_cols); + + # Add the ResultSet's alias - foreach my $key (grep { ! m/\./ } keys %unique_hash) { - $unique_hash{"$self->{attrs}{alias}.$key"} = delete $unique_hash{$key}; ++ foreach my $key (grep { ! m/\./ } keys %$unique_query) { ++ $unique_query->{"$self->{attrs}{alias}.$key"} = delete $unique_query->{$key}; + } + - push @unique_hashes, \%unique_hash if %unique_hash; ++ push @unique_queries, $unique_query if %$unique_query; } - #warn Dumper($query); - + + # Handle cases where the ResultSet already defines the query - my $query = @unique_hashes ? \@unique_hashes : undef; ++ my $query = @unique_queries ? \@unique_queries : undef; + + # Run the query if (keys %$attrs) { - my $rs = $self->search($query,$attrs); - return keys %{$rs->{collapse}} ? $rs->next : $rs->single; - } else { - return keys %{$self->{collapse}} ? - $self->search($query)->next : - $self->single($query); + my $rs = $self->search($query, $attrs); + return keys %{$rs->{collapse}} ? $rs->next : $rs->single; } + else { + return keys %{$self->{collapse}} + ? $self->search($query)->next + : $self->single($query); + } + } + -# _unique_hash ++# _build_unique_query + # -# Constrain the specified hash based on the specified column names. ++# Constrain the specified query hash based on the specified column names. + -sub _unique_hash { - my ($self, $hash, $unique_cols) = @_; - - # Ugh, CDBI lowercases column names - if (exists $INC{'DBIx/Class/CDBICompat/ColumnCase.pm'}) { - foreach my $key (keys %$hash) { - $hash->{lc $key} = delete $hash->{$key}; - } - } ++sub _build_unique_query { ++ my ($self, $query, $unique_cols) = @_; + - my %unique_hash = - map { $_ => $hash->{$_} } - grep { exists $hash->{$_} } ++ my %unique_query = ++ map { $_ => $query->{$_} } ++ grep { exists $query->{$_} } + @$unique_cols; + - return %unique_hash; ++ return \%unique_query; } =head2 search_related