use List::Util 'first';
use Try::Tiny;
use DBIx::Class::Carp;
-use DBIx::Class::_Util 'is_literal_value';
+use SQL::Abstract 'is_literal_value';
###
### Internal method
object (such as a typical C<< L<search|DBIx::Class::ResultSet/search>->
L<next|DBIx::Class::ResultSet/next> >> call) are actually Result
instances, based on your application's
-L<Result class|DBIx::Class::Manual::Glossary/Result_class>.
+L<Result Class|DBIx::Class::Manual::Glossary/Result Class>.
L<DBIx::Class::Row> implements most of the row-based communication with the
underlying storage, but a Result class B<should not inherit from it directly>.
}
$inflated->{$key} = $rel_obj;
next;
- } elsif ($class->has_column($key)
- && $class->column_info($key)->{_inflate_info}) {
+ }
+ elsif (
+ $rsrc->has_column($key)
+ and
+ $rsrc->column_info($key)->{_inflate_info}
+ ) {
$inflated->{$key} = $attrs->{$key};
next;
}
}
- $new->throw_exception("No such column '$key' on $class")
- unless $class->has_column($key);
$new->store_column($key => $attrs->{$key});
}
Indicates whether the object exists as a row in the database or
not. This is set to true when L<DBIx::Class::ResultSet/find>,
-L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
-are used.
+L<DBIx::Class::ResultSet/create> or L<DBIx::Class::Row/insert>
+are invoked.
Creating a result object using L<DBIx::Class::ResultSet/new_result>, or
calling L</delete> on one, sets it to false.
));
}
- $self->throw_exception( "No such column '${column}'" )
- unless $self->has_column($column);
+ $self->throw_exception( "No such column '${column}' on " . ref $self )
+ unless $self->result_source->has_column($column);
return undef;
}
) ? 1 : 0;
}
+sub _has_related_resultset_cached {
+ my ($self, $relname) = @_;
+
+ my $accessor = ($self->relationship_info($relname) || {})->{attrs}{accessor} || '';
+
+ return ((
+ $accessor eq 'single'
+ and
+ exists $self->{_relationship_data}{$relname}
+ ) or (
+ $accessor eq 'filter'
+ and
+ exists $self->{_inflated_column}{$relname}
+ ) or (
+ defined $self->{related_resultsets}{$relname}
+ and
+ defined $self->{related_resultsets}{$relname}->get_cache
+ )) ? 1 : 0;
+}
+
=head2 get_columns
my %data = $result->get_columns;
) if (
! $ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS}
and
- defined $self->{related_resultsets}{$col}
- and
- defined $self->{related_resultsets}{$col}->get_cache
+ $self->_has_related_resultset_cached($col)
);
$self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}));
sub make_column_dirty {
my ($self, $column) = @_;
- $self->throw_exception( "No such column '${column}'" )
- unless exists $self->{_column_data}{$column} || $self->has_column($column);
+ $self->throw_exception( "No such column '${column}' on " . ref $self )
+ unless exists $self->{_column_data}{$column} || $self->result_source->has_column($column);
# the entire clean/dirty code relies on exists, not on true/false
return 1 if exists $self->{_dirty_columns}{$column};
sub get_inflated_columns {
my $self = shift;
- my $loaded_colinfo = $self->columns_info ([
- grep { $self->has_column_loaded($_) } $self->columns
- ]);
+ my $loaded_colinfo = $self->result_source->columns_info;
+ $self->has_column_loaded($_) or delete $loaded_colinfo->{$_}
+ for keys %$loaded_colinfo;
my %cols_to_return = ( %{$self->{_column_data}}, %$loaded_colinfo );
if (
$loaded_colinfo->{$_}{_inflate_info}
and
- defined $self->{related_resultsets}{$_}
- and
- defined $self->{related_resultsets}{$_}->get_cache
+ $self->_has_related_resultset_cached($_)
) {
carp_unique(
"Returning prefetched 'filter' rels as part of get_inflated_columns() is deprecated and will "
}
sub _is_column_numeric {
- my ($self, $column) = @_;
- my $colinfo = $self->column_info ($column);
+ my ($self, $column) = @_;
+
+ return undef unless $self->result_source->has_column($column);
+
+ my $colinfo = $self->result_source->column_info ($column);
# cache for speed (the object may *not* have a resultsource instance)
if (
my $dirty =
$self->{_dirty_columns}{$column}
||
- $self->in_storage # no point tracking dirtyness on uninserted data
+ ( $self->in_storage # no point tracking dirtyness on uninserted data
? ! $self->_eq_column_values ($column, $old_value, $new_value)
: 1
+ )
;
if ($dirty) {
# value tracked between column changes and commitment to storage
sub _track_storage_value {
my ($self, $col) = @_;
- return defined first { $col eq $_ } ($self->primary_columns);
+ return defined first { $col eq $_ } ($self->result_source->primary_columns);
}
=head2 set_columns
sub set_inflated_columns {
my ( $self, $upd ) = @_;
+ my $rsrc;
foreach my $key (keys %$upd) {
if (ref $upd->{$key}) {
- my $info = $self->relationship_info($key);
+ $rsrc ||= $self->result_source;
+ my $info = $rsrc->relationship_info($key);
my $acc_type = $info->{attrs}{accessor} || '';
if ($acc_type eq 'single') {
"Recursive update is not supported over relationships of type '$acc_type' ($key)"
);
}
- elsif ($self->has_column($key) && exists $self->column_info($key)->{_inflate_info}) {
+ elsif (
+ $rsrc->has_column($key)
+ and
+ exists $rsrc->column_info($key)->{_inflate_info}
+ ) {
$self->set_inflated_column($key, delete $upd->{$key});
}
}
sub copy {
my ($self, $changes) = @_;
$changes ||= {};
- my $col_data = { %{$self->{_column_data}} };
+ my $col_data = { $self->get_columns };
- my $colinfo = $self->columns_info([ keys %$col_data ]);
+ my $rsrc = $self->result_source;
+
+ my $colinfo = $rsrc->columns_info;
foreach my $col (keys %$col_data) {
delete $col_data->{$col}
- if $colinfo->{$col}{is_auto_increment};
+ if ( ! $colinfo->{$col} or $colinfo->{$col}{is_auto_increment} );
}
my $new = { _column_data => $col_data };
bless $new, ref $self;
- $new->result_source($self->result_source);
+ $new->result_source($rsrc);
$new->set_inflated_columns($changes);
$new->insert;
# constraints
my $rel_names_copied = {};
- foreach my $rel_name ($self->result_source->relationships) {
- my $rel_info = $self->result_source->relationship_info($rel_name);
+ foreach my $rel_name ($rsrc->relationships) {
+ my $rel_info = $rsrc->relationship_info($rel_name);
next unless $rel_info->{attrs}{cascade_copy};
- my $resolved = $self->result_source->_resolve_condition(
+ my $resolved = $rsrc->_resolve_condition(
$rel_info->{cond}, $rel_name, $new, $rel_name
);
my $copied = $rel_names_copied->{ $rel_info->{source} } ||= {};
foreach my $related ($self->search_related($rel_name)->all) {
- my $id_str = join("\0", $related->id);
- next if $copied->{$id_str};
- $copied->{$id_str} = 1;
- my $rel_copy = $related->copy($resolved);
+ $related->copy($resolved)
+ unless $copied->{$related->ID}++;
}
}
sub store_column {
my ($self, $column, $value) = @_;
- $self->throw_exception( "No such column '${column}'" )
- unless exists $self->{_column_data}{$column} || $self->has_column($column);
+ $self->throw_exception( "No such column '${column}' on " . ref $self )
+ unless exists $self->{_column_data}{$column} || $self->result_source->has_column($column);
$self->throw_exception( "set_column called for ${column} without value" )
if @_ < 3;
return $self->{_column_data}{$column} = $value;
sub inflate_result {
my ($class, $rsrc, $me, $prefetch) = @_;
+ # XXX: WTF is $me sometimes undef?
my $new = bless
- { _column_data => $me, _result_source => $rsrc },
+ { _column_data => $me || {}, _result_source => $rsrc },
ref $class || $class
;
$class->throw_exception("No accessor type declared for prefetched relationship '$rel_name'")
unless $relinfo->{attrs}{accessor};
- my $rel_rs = $new->related_resultset($rel_name);
+ my $rel_rsrc = $rsrc->related_source($rel_name);
my @rel_objects;
if (
) {
if (ref $prefetch->{$rel_name}[0] eq 'ARRAY') {
- my $rel_rsrc = $rel_rs->result_source;
- my $rel_class = $rel_rs->result_class;
+ my $rel_class = $rel_rsrc->result_class;
my $rel_inflator = $rel_class->can('inflate_result');
@rel_objects = map
{ $rel_class->$rel_inflator ( $rel_rsrc, @$_ ) }
;
}
else {
- @rel_objects = $rel_rs->result_class->inflate_result(
- $rel_rs->result_source, @{$prefetch->{$rel_name}}
+ @rel_objects = $rel_rsrc->result_class->inflate_result(
+ $rel_rsrc, @{$prefetch->{$rel_name}}
);
}
}
elsif ($relinfo->{attrs}{accessor} eq 'filter') {
$new->{_inflated_column}{$rel_name} = $rel_objects[0];
}
-
- $rel_rs->set_cache(\@rel_objects);
+ else {
+ $new->related_resultset($rel_name)->set_cache(\@rel_objects);
+ }
}
}
=back
-L</Update>s the object if it's already in the database, according to
+L</update>s the object if it's already in the database, according to
L</in_storage>, else L</insert>s it.
=head2 insert_or_update
Returns the primary key(s) for a row. Can't be called as a class method.
Actually implemented in L<DBIx::Class::PK>
-=head1 AUTHOR AND CONTRIBUTORS
+=head1 FURTHER QUESTIONS?
-See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
-You may distribute this code under the same terms as Perl itself.
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
=cut
projects / dbsrgits/DBIx-Class.git / blobdiff