From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 15 Nov 2005 06:21:38 +0000 (+0000)
Subject: Added has_column and column_info methods
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=103647d504eeadac7d179057e9f4d5eda0cd7c1b;p=dbsrgits%2FDBIx-Class-Historic.git

Added has_column and column_info methods
---

diff --git a/Changes b/Changes
index 600beaf..fdc7452 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,8 @@ Revision history for DBIx::Class
 
         - Moved get_simple and set_simple into AccessorGroup
         - Made 'new' die if given invalid columns
+        - Added has_column and column_info to Table.pm
+        - Refactored away from direct use of _columns and _primaries
 
 0.03004
         - Added an || '' to the CDBICompat stringify to avoid null warnings
diff --git a/lib/DBIx/Class/CDBICompat/AccessorMapping.pm b/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
index 6d5e4b0..2489d3f 100644
--- a/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
+++ b/lib/DBIx/Class/CDBICompat/AccessorMapping.pm
@@ -32,7 +32,7 @@ sub create {
   $class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
   $attrs = { %$attrs };
   my %att;
-  foreach my $col (keys %{ $class->_columns }) {
+  foreach my $col ($class->columns) {
     if ($class->can('accessor_name')) {
       my $acc = $class->accessor_name($col);
 #warn "$col $acc";
diff --git a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
index 4c0b148..fc9ece3 100644
--- a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
+++ b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm
@@ -58,13 +58,13 @@ sub all_columns { return keys %{$_[0]->_columns}; }
 
 sub primary_column {
   my ($class) = @_;
-  my @pri = keys %{$class->_primaries};
+  my @pri = $class->primary_columns;
   return wantarray ? @pri : $pri[0];
 }
 
 sub find_column {
   my ($class, $col) = @_;
-  return $col if $class->_columns->{$col};
+  return $col if $class->has_column($col);
 }
 
 sub __grouper {
diff --git a/lib/DBIx/Class/CDBICompat/HasA.pm b/lib/DBIx/Class/CDBICompat/HasA.pm
index e35c221..4547ab5 100644
--- a/lib/DBIx/Class/CDBICompat/HasA.pm
+++ b/lib/DBIx/Class/CDBICompat/HasA.pm
@@ -5,7 +5,7 @@ use warnings;
 
 sub has_a {
   my ($self, $col, $f_class, %args) = @_;
-  $self->throw( "No such column ${col}" ) unless $self->_columns->{$col};
+  $self->throw( "No such column ${col}" ) unless $self->has_column($col);
   eval "require $f_class";
   if ($args{'inflate'} || $args{'deflate'}) { # Non-database has_a
     if (!ref $args{'inflate'}) {
diff --git a/lib/DBIx/Class/CDBICompat/TempColumns.pm b/lib/DBIx/Class/CDBICompat/TempColumns.pm
index 64d6d20..a1f7d6d 100644
--- a/lib/DBIx/Class/CDBICompat/TempColumns.pm
+++ b/lib/DBIx/Class/CDBICompat/TempColumns.pm
@@ -58,7 +58,7 @@ sub set_temp {
 }
 
 sub has_real_column {
-  return 1 if shift->_columns->{shift};
+  return 1 if shift->has_column(shift);
 }
 
 1;
diff --git a/lib/DBIx/Class/InflateColumn.pm b/lib/DBIx/Class/InflateColumn.pm
index 7a8a613..01d9e33 100644
--- a/lib/DBIx/Class/InflateColumn.pm
+++ b/lib/DBIx/Class/InflateColumn.pm
@@ -5,9 +5,9 @@ use warnings;
 
 sub inflate_column {
   my ($self, $col, $attrs) = @_;
-  die "No such column $col to inflate" unless exists $self->_columns->{$col};
+  die "No such column $col to inflate" unless $self->has_column($col);
   die "inflate_column needs attr hashref" unless ref $attrs eq 'HASH';
-  $self->_columns->{$col}{_inflate_info} = $attrs;
+  $self->column_info($col)->{_inflate_info} = $attrs;
   $self->mk_group_accessors('inflated_column' => $col);
   return 1;
 }
@@ -15,25 +15,27 @@ sub inflate_column {
 sub _inflated_column {
   my ($self, $col, $value) = @_;
   return $value unless defined $value; # NULL is NULL is NULL
-  return $value unless exists $self->_columns->{$col}{_inflate_info};
-  return $value unless exists $self->_columns->{$col}{_inflate_info}{inflate};
-  my $inflate = $self->_columns->{$col}{_inflate_info}{inflate};
+  my $info = $self->column_info($col) || die "No column info for $col";
+  return $value unless exists $info->{_inflate_info};
+  my $inflate = $info->{_inflate_info}{inflate};
+  die "No inflator for $col" unless defined $inflate;
   return $inflate->($value, $self);
 }
 
 sub _deflated_column {
   my ($self, $col, $value) = @_;
   return $value unless ref $value; # If it's not an object, don't touch it
-  return $value unless exists $self->_columns->{$col}{_inflate_info};
-  return $value unless exists $self->_columns->{$col}{_inflate_info}{deflate};
-  my $deflate = $self->_columns->{$col}{_inflate_info}{deflate};
+  my $info = $self->column_info($col) || die "No column info for $col";
+  return $value unless exists $info->{_inflate_info};
+  my $deflate = $info->{_inflate_info}{deflate};
+  die "No deflator for $col" unless defined $deflate;
   return $deflate->($value, $self);
 }
 
 sub get_inflated_column {
   my ($self, $col) = @_;
   $self->throw("$col is not an inflated column") unless
-    exists $self->_columns->{$col}{_inflate_info};
+    exists $self->column_info($col)->{_inflate_info};
 
   return $self->{_inflated_column}{$col}
     if exists $self->{_inflated_column}{$col};
@@ -68,7 +70,8 @@ sub new {
   my ($class, $attrs, @rest) = @_;
   $attrs ||= {};
   foreach my $key (keys %$attrs) {
-    if (ref $attrs->{$key} && exists $class->_columns->{$key}{_inflate_info}) {
+    if (ref $attrs->{$key}
+          && exists $class->column_info($key)->{_inflate_info}) {
       $attrs->{$key} = $class->_deflated_column($key, $attrs->{$key});
     }
   }
diff --git a/lib/DBIx/Class/ObjectCache.pm b/lib/DBIx/Class/ObjectCache.pm
index 7827a57..39fb218 100644
--- a/lib/DBIx/Class/ObjectCache.pm
+++ b/lib/DBIx/Class/ObjectCache.pm
@@ -46,7 +46,7 @@ sub find {
   # but, it's a start anyway. probably find in PK.pm needs to
   # call a hook, or some such thing. -Dave/ningu
   my ($object,$key);
-  my @pk = keys %{$self->_primaries};
+  my @pk = $self->primary_columns;
   if (ref $vals[0] eq 'HASH') {
     my $cond = $vals[0]->{'-and'};
     $key = $self->_create_ID(%{$cond->[0]}) if ref $cond eq 'ARRAY';
diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm
index 3bb0740..ab135e0 100644
--- a/lib/DBIx/Class/PK.pm
+++ b/lib/DBIx/Class/PK.pm
@@ -98,8 +98,6 @@ sub discard_changes {
   }
   delete @{$self}{keys %$self};
   @{$self}{keys %$reload} = values %$reload;
-  #$self->store_column($_ => $reload->get_column($_))
-  #  foreach keys %{$self->_columns};
   return $self;
 }
 
@@ -141,6 +139,13 @@ sub _create_ID {
   return join '|', $class, map { $_ . '=' . $vals{$_} } sort keys %vals;    
 }
 
+sub ident_condition {
+  my ($self) = @_;
+  my %cond;
+  $cond{$_} = $self->get_column($_) for $self->primary_columns;
+  return \%cond;
+}
+
 1;
 
 =back
diff --git a/lib/DBIx/Class/PK/Auto.pm b/lib/DBIx/Class/PK/Auto.pm
index 84e679a..c2027cc 100644
--- a/lib/DBIx/Class/PK/Auto.pm
+++ b/lib/DBIx/Class/PK/Auto.pm
@@ -35,13 +35,13 @@ sub insert {
 
   # if all primaries are already populated, skip auto-inc
   my $populated = 0;
-  map { $populated++ if $self->$_ } keys %{ $self->_primaries };
-  return $ret if ( $populated == scalar keys %{ $self->_primaries } );
+  map { $populated++ if $self->$_ } $self->primary_columns;
+  return $ret if ( $populated == scalar $self->primary_columns );
 
   my ($pri, $too_many) =
-    (grep { $self->_primaries->{$_}{'auto_increment'} }
-       keys %{ $self->_primaries })
-    || (keys %{ $self->_primaries });
+    (grep { $self->column_info($_)->{'auto_increment'} }
+       $self->primary_columns)
+    || $self->primary_columns;
   $self->throw( "More than one possible key found for auto-inc on ".ref $self )
     if $too_many;
   unless (defined $self->get_column($pri)) {
diff --git a/lib/DBIx/Class/Relationship/Accessor.pm b/lib/DBIx/Class/Relationship/Accessor.pm
index 7e215d4..069da80 100644
--- a/lib/DBIx/Class/Relationship/Accessor.pm
+++ b/lib/DBIx/Class/Relationship/Accessor.pm
@@ -32,7 +32,7 @@ sub add_relationship_accessor {
     };
   } elsif ($acc_type eq 'filter') {
     $class->throw("No such column $rel to filter")
-       unless exists $class->_columns->{$rel};
+       unless $class->has_column($rel);
     my $f_class = $class->_relationships->{$rel}{class};
     $class->inflate_column($rel,
       { inflate => sub {
diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index 2747995..5b654af 100644
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -48,9 +48,8 @@ sub add_relationship {
                   cond  => $cond,
                   attrs => $attrs };
   $class->_relationships(\%rels);
-  #warn %{$f_class->_columns};
 
-  return unless eval { %{$f_class->_columns}; }; # Foreign class not loaded
+  return unless eval { $f_class->can('columns'); }; # Foreign class not loaded
   eval { $class->_resolve_join($rel, 'me') };
 
   if ($@) { # If the resolve failed, back out and re-throw the error
@@ -117,7 +116,7 @@ sub _cond_key {
     if (my $alias = $attrs->{_aliases}{$type}) {
       my $class = $attrs->{_classes}{$alias};
       $self->throw("Unknown column $field on $class as $alias")
-        unless exists $class->_columns->{$field};
+        unless $class->has_column($field);
       return join('.', $alias, $field);
     } else {
       $self->throw( "Unable to resolve type ${type}: only have aliases for ".
@@ -134,7 +133,7 @@ sub _cond_value {
     unless ($value =~ s/^self\.//) {
       $self->throw( "Unable to convert relationship to WHERE clause: invalid value ${value}" );
     }
-    unless ($self->_columns->{$value}) {
+    unless ($self->has_column($value)) {
       $self->throw( "Unable to convert relationship to WHERE clause: no such accessor ${value}" );
     }
     return $self->get_column($value);
@@ -144,7 +143,7 @@ sub _cond_value {
     if (my $alias = $attrs->{_aliases}{$type}) {
       my $class = $attrs->{_classes}{$alias};
       $self->throw("Unknown column $field on $class as $alias")
-        unless exists $class->_columns->{$field};
+        unless $class->has_column($field);
       return join('.', $alias, $field);
     } else {
       $self->throw( "Unable to resolve type ${type}: only have aliases for ".
diff --git a/lib/DBIx/Class/Relationship/BelongsTo.pm b/lib/DBIx/Class/Relationship/BelongsTo.pm
index 0cc441e..aca69aa 100644
--- a/lib/DBIx/Class/Relationship/BelongsTo.pm
+++ b/lib/DBIx/Class/Relationship/BelongsTo.pm
@@ -6,14 +6,15 @@ use warnings;
 sub belongs_to {
   my ($class, $rel, $f_class, $cond, $attrs) = @_;
   eval "require $f_class";
-  my %f_primaries = eval { %{ $f_class->_primaries } };
+  my %f_primaries;
+  $f_primaries{$_} = 1 for eval { $f_class->primary_columns };
   my $f_loaded = !$@;
   # single key relationship
   if (not defined $cond) {
     $class->throw("Can't infer join condition for ${rel} on ${class}; unable to load ${f_class}") unless $f_loaded;
     my ($pri, $too_many) = keys %f_primaries;
     $class->throw("Can't infer join condition for ${rel} on ${class}; ${f_class} has multiple primary key") if $too_many;
-    my $acc_type = ($class->_columns->{$rel}) ? 'filter' : 'single';
+    my $acc_type = ($class->has_column($rel)) ? 'filter' : 'single';
     $class->add_relationship($rel, $f_class,
       { "foreign.${pri}" => "self.${rel}" },
       { accessor => $acc_type, %{$attrs || {}} }
diff --git a/lib/DBIx/Class/Relationship/HasMany.pm b/lib/DBIx/Class/Relationship/HasMany.pm
index 00dd986..f30ff50 100644
--- a/lib/DBIx/Class/Relationship/HasMany.pm
+++ b/lib/DBIx/Class/Relationship/HasMany.pm
@@ -9,11 +9,11 @@ sub has_many {
   eval "require $f_class";
 
   unless (ref $cond) {
-    my ($pri, $too_many) = keys %{ $class->_primaries };
+    my ($pri, $too_many) = $class->primary_columns;
     $class->throw( "has_many can only infer join for a single primary key; ${class} has more" )
       if $too_many;
     my $f_key;
-    my $f_class_loaded = eval { $f_class->_columns };
+    my $f_class_loaded = eval { $f_class->columns };
     my $guess;
     if (defined $cond && length $cond) {
       $f_key = $cond;
@@ -24,7 +24,7 @@ sub has_many {
       $guess = "using our class name '$class' as foreign key";
     }
     $class->throw("No such column ${f_key} on foreign class ${f_class} ($guess)")
-      if $f_class_loaded && !exists $f_class->_columns->{$f_key}; 
+      if $f_class_loaded && !$f_class->has_column($f_key);
     $cond = { "foreign.${f_key}" => "self.${pri}" },
   }
 
diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm
index b9ab33d..d114a39 100644
--- a/lib/DBIx/Class/Relationship/HasOne.pm
+++ b/lib/DBIx/Class/Relationship/HasOne.pm
@@ -15,26 +15,26 @@ sub _has_one {
   my ($class, $join_type, $rel, $f_class, $cond, $attrs) = @_;
   eval "require $f_class";
   unless (ref $cond) {
-    my ($pri, $too_many) = keys %{ $class->_primaries };
+    my ($pri, $too_many) = $class->primary_columns;
     $class->throw( "might_have/has_one can only infer join for a single primary key; ${class} has more" )
       if $too_many;
     my $f_key;
-    my $f_class_loaded = eval { $f_class->_columns };
+    my $f_class_loaded = eval { $f_class->columns };
     my $guess;
     if (defined $cond && length $cond) {
       $f_key = $cond;
       $guess = "caller specified foreign key '$f_key'";
-    } elsif ($f_class_loaded && $f_class->_columns->{$rel}) {
+    } elsif ($f_class_loaded && $f_class->has_column($rel)) {
       $f_key = $rel;
       $guess = "using given relationship '$rel' for foreign key";
     } else {
-      ($f_key, $too_many) = keys %{ $f_class->_primaries };
+      ($f_key, $too_many) = $f_class->primary_columns;
       $class->throw( "might_have/has_one can only infer join for a single primary key; ${f_class} has more" )
         if $too_many;
       $guess = "using primary key of foreign class for foreign key";
     }
     $class->throw("No such column ${f_key} on foreign class ${f_class} ($guess)")
-      if $f_class_loaded && !exists $f_class->_columns->{$f_key}; 
+      if $f_class_loaded && !$f_class->has_column($f_key);
     $cond = { "foreign.${f_key}" => "self.${pri}" };
   }
   $class->add_relationship($rel, $f_class,
diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 9f01ded..0585fd8 100644
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -33,7 +33,7 @@ sub new {
   if ($attrs) {
     $new->throw("attrs must be a hashref" ) unless ref($attrs) eq 'HASH';
     while (my ($k, $v) = each %{$attrs}) {
-      die "No such column $k on $class" unless exists $class->_columns->{$k};
+      die "No such column $k on $class" unless $class->has_column($k);
       $new->store_column($k => $v);
     }
   }
@@ -122,13 +122,6 @@ sub update {
   return $self;
 }
 
-sub ident_condition {
-  my ($self) = @_;
-  my %cond;
-  $cond{$_} = $self->get_column($_) for keys %{$self->_primaries};
-  return \%cond;
-}
-
 =item delete
 
   $obj->delete
@@ -171,7 +164,7 @@ Fetches a column value
 sub get_column {
   my ($self, $column) = @_;
   $self->throw( "Can't fetch data as class method" ) unless ref $self;
-  $self->throw( "No such column '${column}'" ) unless $self->_columns->{$column};
+  $self->throw( "No such column '${column}'" ) unless $self->has_column($column);
   return $self->{_column_data}{$column}
     if exists $self->{_column_data}{$column};
   return undef;
@@ -242,7 +235,7 @@ Sets a column value without marking it as dirty
 sub store_column {
   my ($self, $column, $value) = @_;
   $self->throw( "No such column '${column}'" ) 
-    unless $self->_columns->{$column};
+    unless $self->has_column($column);
   $self->throw( "set_column called for ${column} without value" ) 
     if @_ < 3;
   return $self->{_column_data}{$column} = $value;
diff --git a/lib/DBIx/Class/Table.pm b/lib/DBIx/Class/Table.pm
index 3ded88c..2dfe57b 100644
--- a/lib/DBIx/Class/Table.pm
+++ b/lib/DBIx/Class/Table.pm
@@ -184,6 +184,39 @@ sub find_or_create {
   return defined($exists) ? $exists : $class->create($hash);
 }
 
+=item has_column                                                                
+                                                                                
+  if ($obj->has_column($col)) { ... }                                           
+                                                                                
+Returns 1 if the object has a column of this name, 0 otherwise                  
+                                                                                
+=cut                                                                            
+
+sub has_column {
+  my ($self, $column) = @_;
+  return exists $self->_columns->{$column};
+}
+
+=item column_info                                                               
+                                                                                
+  my $info = $obj->column_info($col);                                           
+                                                                                
+Returns the column metadata hashref for the column                              
+                                                                                
+=cut                                                                            
+
+sub column_info {
+  my ($self, $column) = @_;
+  die "No such column $column" unless exists $self->_columns->{$column};
+  return $self->_columns->{$column};
+}
+
+=item columns                                                                   
+                                                                                
+  my @column_names = $obj->columns;                                             
+                                                                                
+=cut                                                                            
+
 sub columns { return keys %{shift->_columns}; }
 
 1;
diff --git a/lib/DBIx/Class/UUIDColumns.pm b/lib/DBIx/Class/UUIDColumns.pm
index d45eac8..15d6826 100644
--- a/lib/DBIx/Class/UUIDColumns.pm
+++ b/lib/DBIx/Class/UUIDColumns.pm
@@ -34,7 +34,7 @@ Note that the component needs to be loaded before Core.
 sub uuid_columns {
     my $self = shift;
     for (@_) {
-	die "column $_ doesn't exist" unless exists $self->_columns->{$_};
+	die "column $_ doesn't exist" unless $self->has_column($_);
     }
     $self->uuid_auto_columns(\@_);
 }
@@ -42,8 +42,8 @@ sub uuid_columns {
 sub insert {
     my ($self) = @_;
     for my $column (@{$self->uuid_auto_columns}) {
-	$self->$column( $self->get_uuid )
-	    unless defined $self->$column;
+	$self->store_column( $column, $self->get_uuid )
+	    unless defined $self->get_column( $column );
     }
     $self->NEXT::ACTUAL::insert;
 }