Tweaked, prodded, refactored. Thanks to draven for the in_database bits

diff --git a/lib/DBIx/Class/AccessorGroup.pm b/lib/DBIx/Class/AccessorGroup.pm
index 35fcec9..a7e85be 100644 (file)
--- a/lib/DBIx/Class/AccessorGroup.pm
+++ b/lib/DBIx/Class/AccessorGroup.pm
@@ -3,11 +3,8 @@ package DBIx::Class::AccessorGroup;
 use strict;
 use warnings;
 
-use base qw/Class::Data::Inheritable/;
 use NEXT;
 
-__PACKAGE__->mk_classdata('_accessor_group_deleted' => { });
-
 sub mk_group_accessors {
     my($self, $group, @fields) = @_;
 
@@ -122,13 +119,4 @@ sub make_group_wo_accessor {
     };
 }
 
-sub delete_accessor {
-  my ($class, $accessor) = @_;
-  $class = ref $class if ref $class;
-  my $sym = "${class}::${accessor}";
-  undef &$sym;
-  delete $DB::sub{$sym};
-  #$class->_accessor_group_deleted->{"${class}::${accessor}"} = 1;
-}
-
 1;

diff --git a/lib/DBIx/Class/CDBICompat/AccessorMapping.pm b/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
index 1604a7c..bb4f214 100644 (file)
--- a/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
+++ b/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
@@ -17,6 +17,7 @@ sub mk_group_accessors {
     my $wo_meth = ($class->can('mutator_name')
                     ? $class->mutator_name($col)
                     : $col);
+    #warn "$col $ro_meth $wo_meth";
     if ($ro_meth eq $wo_meth) {
       $class->NEXT::ACTUAL::mk_group_accessors($group => [ $ro_meth => $col ]);
     } else {

diff --git a/lib/DBIx/Class/CDBICompat/ColumnCase.pm b/lib/DBIx/Class/CDBICompat/ColumnCase.pm
index 2e6225d..2916bab 100644 (file)
--- a/lib/DBIx/Class/CDBICompat/ColumnCase.pm
+++ b/lib/DBIx/Class/CDBICompat/ColumnCase.pm
@@ -17,7 +17,6 @@ sub _register_columns {
 sub has_a {
   my ($class, $col, @rest) = @_;
   $class->NEXT::ACTUAL::has_a(lc($col), @rest);
-  $class->delete_accessor($col);
   $class->mk_group_accessors('has_a' => $col);
   return 1;
 }
@@ -68,6 +67,7 @@ sub _mk_group_accessors {
   my @extra;
   foreach (@fields) {
     my ($acc, $field) = ref $_ ? @$_ : ($_, $_);
+    #warn "$acc ".lc($acc)." $field";
     next if defined &{"${class}::${acc}"};
     push(@extra, [ lc $acc => $field ]);
   }

diff --git a/lib/DBIx/Class/CDBICompat/HasA.pm b/lib/DBIx/Class/CDBICompat/HasA.pm
index b90d11c..88e7cac 100644 (file)
--- a/lib/DBIx/Class/CDBICompat/HasA.pm
+++ b/lib/DBIx/Class/CDBICompat/HasA.pm
@@ -13,7 +13,6 @@ sub has_a {
   $self->add_relationship($col, $f_class,
                             { "foreign.${pri}" => "self.${col}" },
                             { _type => 'has_a' } );
-  $self->delete_accessor($col);
   $self->mk_group_accessors('has_a' => $col);
   return 1;
 }

diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm
index edb7277..ad70690 100644 (file)
--- a/lib/DBIx/Class/PK.pm
+++ b/lib/DBIx/Class/PK.pm
@@ -26,13 +26,14 @@ sub set_primary_key {
 
 sub retrieve {
   my ($class, @vals) = @_;
+  my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
   my @pk = keys %{$class->_primaries};
   die "Can't retrieve unless primary columns are defined" unless @pk;
   my $query;
   if (ref $vals[0] eq 'HASH') {
     $query = $vals[0];
   } elsif (@pk == @vals) {
-    my $ret = ($class->retrieve_from_sql($class->_ident_cond, @vals))[0];
+    my $ret = ($class->retrieve_from_sql($class->_ident_cond, @vals, $attrs))[0];
     #warn "$class: ".join(', ', %{$ret->{_column_data}});
     return $ret;
   } else {

diff --git a/lib/DBIx/Class/Relationship.pm b/lib/DBIx/Class/Relationship.pm
index 3fef7a3..fc48fdc 100644 (file)
--- a/lib/DBIx/Class/Relationship.pm
+++ b/lib/DBIx/Class/Relationship.pm
@@ -43,7 +43,7 @@ sub _cond_value {
     unless ($value =~ s/^self\.//) {
       die "Unable to convert relationship to WHERE clause: invalid value ${value}";
     }
-    unless ($self->can($value)) {
+    unless ($self->_columns->{$value}) {
       die "Unable to convert relationship to WHERE clause: no such accessor ${value}";
     }
     push(@{$attrs->{bind}}, $self->get_column($value));
@@ -80,7 +80,8 @@ sub search_related {
   $attrs->{_action} = 'convert';
   my ($cond) = $self->_cond_resolve($rel_obj->{cond}, $attrs);
   $cond = "${s_cond} AND ${cond}" if $s_cond;
-  return $rel_obj->{class}->retrieve_from_sql($cond, @{$attrs->{bind} || {}});
+  return $rel_obj->{class}->retrieve_from_sql($cond, @{$attrs->{bind} || []},
+                                                $attrs);
 }
 
 sub create_related {

diff --git a/lib/DBIx/Class/Table.pm b/lib/DBIx/Class/Table.pm
index 51d7ceb..1ccf7e9 100644 (file)
--- a/lib/DBIx/Class/Table.pm
+++ b/lib/DBIx/Class/Table.pm
@@ -26,18 +26,20 @@ sub new {
 
 sub insert {
   my ($self) = @_;
-  return if $self->{_in_database};
+  return if $self->in_database;
   my $sth = $self->_get_sth('insert', [ keys %{$self->{_column_data}} ],
                               $self->_table_name, undef);
   $sth->execute(values %{$self->{_column_data}});
   $sth->finish;
-  $self->{_in_database} = 1;
+  $self->in_database(1);
   $self->{_dirty_columns} = {};
   return $self;
 }
 
 sub in_database {
-  return $_[0]->{_in_database};
+  my ($self, $val) = @_;
+  $self->{_in_database} = $val if @_ > 1;
+  return $self->{_in_database};
 }
 
 sub create {
@@ -48,7 +50,7 @@ sub create {
 
 sub update {
   my ($self) = @_;
-  die "Not in database" unless $self->{_in_database};
+  die "Not in database" unless $self->in_database;
   my @to_update = keys %{$self->{_dirty_columns} || {}};
   return -1 unless @to_update;
   my $sth = $self->_get_sth('update', \@to_update,
@@ -68,13 +70,13 @@ sub update {
 sub delete {
   my $self = shift;
   if (ref $self) {
-    die "Not in database" unless $self->{_in_database};
+    die "Not in database" unless $self->in_database;
     #warn $self->_ident_cond.' '.join(', ', $self->_ident_values);
     my $sth = $self->_get_sth('delete', undef,
                                 $self->_table_name, $self->_ident_cond);
     $sth->execute($self->_ident_values);
     $sth->finish;
-    delete $self->{_in_database};
+    $self->in_database(undef);
   } else {
     my $attrs = { };
     if (@_ > 1 && ref $_[$#_] eq 'HASH') {
@@ -147,7 +149,7 @@ sub sth_to_objects {
   while (my @row = $sth->fetchrow_array) {
     my $new = $class->new;
     $new->store_column($_, shift @row) for @cols;
-    $new->{_in_database} = 1;
+    $new->in_database(1);
     push(@found, $new);
   }
   $sth->finish;
@@ -162,7 +164,7 @@ sub search {
   }
   my $query    = ref $_[0] eq "HASH" ? shift: {@_};
   my ($cond, @param)  = $class->_cond_resolve($query, $attrs);
-  return $class->retrieve_from_sql($cond, @param);
+  return $class->retrieve_from_sql($cond, @param, $attrs);
 }
 
 sub search_like {