Merge 'find_changes' into 'DBIx-Class-current'
Daniel Westermann-Clark [Wed, 19 Apr 2006 15:19:51 +0000 (15:19 +0000)]
- 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

1  2 
Changes
lib/DBIx/Class/CDBICompat/ColumnCase.pm
lib/DBIx/Class/CDBICompat/Retrieve.pm
lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/ResultSource.pm

diff --cc 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
@@@ -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);
@@@ -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 {
@@@ -290,44 -304,82 +302,78 @@@ L<DBIx::Class::ResultSource/add_unique_
  =cut
  
  sub find {
-   my ($self, @vals) = @_;
-   my $attrs = (@vals > 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
Simple merge