- 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
$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";
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 {
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'}) {
}
sub has_real_column {
- return 1 if shift->_columns->{shift};
+ return 1 if shift->has_column(shift);
}
1;
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;
}
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};
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});
}
}
# 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';
}
delete @{$self}{keys %$self};
@{$self}{keys %$reload} = values %$reload;
- #$self->store_column($_ => $reload->get_column($_))
- # foreach keys %{$self->_columns};
return $self;
}
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
# 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)) {
};
} 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 {
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
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 ".
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);
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 ".
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 || {}} }
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;
$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}" },
}
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,
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);
}
}
return $self;
}
-sub ident_condition {
- my ($self) = @_;
- my %cond;
- $cond{$_} = $self->get_column($_) for keys %{$self->_primaries};
- return \%cond;
-}
-
=item delete
$obj->delete
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;
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;
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;
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(\@_);
}
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;
}
projects / dbsrgits/DBIx-Class.git / commitdiff