use base qw/DBIx::Class/;
-use DBIx::Class::Exception;
use Scalar::Util 'blessed';
-use List::Util 'first';
-use Try::Tiny;
+use DBIx::Class::_Util qw( dbic_internal_try fail_on_internal_call );
+use DBIx::Class::Carp;
+use SQL::Abstract qw( is_literal_value is_plain_value );
###
### Internal method
use namespace::clean;
+__PACKAGE__->mk_group_accessors ( simple => [ in_storage => '_in_storage' ] );
+
=head1 NAME
DBIx::Class::Row - Basic row methods
=head1 NOTE
All "Row objects" derived from a Schema-attached L<DBIx::Class::ResultSet>
-object (such as a typical C<< L<search|DBIx::Class::ResultSet/search
->->L<next|DBIx::Class::ResultSet/next> >> call) are actually Result
+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>.
=head2 new
- my $row = My::Class->new(\%attrs);
+ my $result = My::Class->new(\%attrs);
- my $row = $schema->resultset('MySource')->new(\%colsandvalues);
+ my $result = $schema->resultset('MySource')->new(\%colsandvalues);
=over
=cut
## It needs to store the new objects somewhere, and call insert on that list later when insert is called on this object. We may need an accessor for these so the user can retrieve them, if just doing ->new().
-## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
+## This only works because DBIC doesn't yet care to check whether the new_related objects have been passed all their mandatory columns
## When doing the later insert, we need to make sure the PKs are set.
## using _relationship_data in new and funky ways..
## check Relationship::CascadeActions and Relationship::Accessor for compat
## tests!
sub __new_related_find_or_new_helper {
- my ($self, $relname, $data) = @_;
+ my ($self, $rel_name, $values) = @_;
my $rsrc = $self->result_source;
# create a mock-object so all new/set_column component overrides will run:
- my $rel_rs = $rsrc->related_source($relname)->resultset;
- my $new_rel_obj = $rel_rs->new_result($data);
+ my $rel_rs = $rsrc->related_source($rel_name)->resultset;
+ my $new_rel_obj = $rel_rs->new_result($values);
my $proc_data = { $new_rel_obj->get_columns };
- if ($self->__their_pk_needs_us($relname)) {
- MULTICREATE_DEBUG and warn "MC $self constructing $relname via new_result";
+ if ($self->__their_pk_needs_us($rel_name)) {
+ MULTICREATE_DEBUG and print STDERR "MC $self constructing $rel_name via new_result\n";
return $new_rel_obj;
}
- elsif ($rsrc->_pk_depends_on($relname, $proc_data )) {
+ elsif ($rsrc->_pk_depends_on($rel_name, $proc_data )) {
if (! keys %$proc_data) {
# there is nothing to search for - blind create
- MULTICREATE_DEBUG and warn "MC $self constructing default-insert $relname";
+ MULTICREATE_DEBUG and print STDERR "MC $self constructing default-insert $rel_name\n";
}
else {
- MULTICREATE_DEBUG and warn "MC $self constructing $relname via find_or_new";
+ MULTICREATE_DEBUG and print STDERR "MC $self constructing $rel_name via find_or_new\n";
# this is not *really* find or new, as we don't want to double-new the
# data (thus potentially double encoding or whatever)
my $exists = $rel_rs->find ($proc_data);
else {
my $us = $rsrc->source_name;
$self->throw_exception (
- "Unable to determine relationship '$relname' direction from '$us', "
- . "possibly due to a missing reverse-relationship on '$relname' to '$us'."
+ "Unable to determine relationship '$rel_name' direction from '$us', "
+ . "possibly due to a missing reverse-relationship on '$rel_name' to '$us'."
);
}
}
sub __their_pk_needs_us { # this should maybe be in resultsource.
- my ($self, $relname) = @_;
- my $source = $self->result_source;
- my $reverse = $source->reverse_relationship_info($relname);
- my $rel_source = $source->related_source($relname);
+ my ($self, $rel_name) = @_;
+ my $rsrc = $self->result_source;
+ my $reverse = $rsrc->reverse_relationship_info($rel_name);
+ my $rel_source = $rsrc->related_source($rel_name);
my $us = { $self->get_columns };
foreach my $key (keys %$reverse) {
# if their primary key depends on us, then we have to
my ($class, $attrs) = @_;
$class = ref $class if ref $class;
- my $new = bless { _column_data => {} }, $class;
+ my $new = bless { _column_data => {}, _in_storage => 0 }, $class;
if ($attrs) {
$new->throw_exception("attrs must be a hashref")
unless ref($attrs) eq 'HASH';
- my $source = delete $attrs->{-result_source};
+ my $rsrc = delete $attrs->{-result_source};
if ( my $h = delete $attrs->{-source_handle} ) {
- $source ||= $h->resolve;
+ $rsrc ||= $h->resolve;
}
- $new->result_source($source) if $source;
+ $new->result_source_instance($rsrc) if $rsrc;
if (my $col_from_rel = delete $attrs->{-cols_from_relations}) {
@{$new->{_ignore_at_insert}={}}{@$col_from_rel} = ();
}
- my ($related,$inflated);
+ my( $related, $inflated, $colinfos );
foreach my $key (keys %$attrs) {
- if (ref $attrs->{$key}) {
+ if (ref $attrs->{$key} and ! is_literal_value($attrs->{$key}) ) {
## Can we extract this lot to use with update(_or .. ) ?
$new->throw_exception("Can't do multi-create without result source")
- unless $source;
- my $info = $source->relationship_info($key);
+ unless $rsrc;
+ my $info = $rsrc->relationship_info($key);
my $acc_type = $info->{attrs}{accessor} || '';
if ($acc_type eq 'single') {
my $rel_obj = delete $attrs->{$key};
$new->{_rel_in_storage}{$key} = 1;
$new->set_from_related($key, $rel_obj);
} else {
- MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj\n";
+ MULTICREATE_DEBUG and print STDERR "MC $new uninserted $key $rel_obj\n";
}
$related->{$key} = $rel_obj;
$rel_obj->throw_exception ('A multi relationship can not be pre-existing when doing multicreate. Something went wrong');
} else {
MULTICREATE_DEBUG and
- warn "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
+ print STDERR "MC $new uninserted $key $rel_obj (${\($idx+1)} of $total)\n";
}
push(@objects, $rel_obj);
}
$new->{_rel_in_storage}{$key} = 1;
}
else {
- MULTICREATE_DEBUG and warn "MC $new uninserted $key $rel_obj";
+ MULTICREATE_DEBUG and print STDERR "MC $new uninserted $key $rel_obj\n";
}
$inflated->{$key} = $rel_obj;
next;
- } elsif ($class->has_column($key)
- && $class->column_info($key)->{_inflate_info}) {
+ }
+ elsif (
+ ( $colinfos ||= $rsrc->columns_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});
}
# Each pair does the same thing
# (un-inflated, regular column)
- my $val = $row->get_column('first_name');
- my $val = $row->first_name;
+ my $val = $result->get_column('first_name');
+ my $val = $result->first_name;
- $row->set_column('first_name' => $val);
- $row->first_name($val);
+ $result->set_column('first_name' => $val);
+ $result->first_name($val);
# (inflated column via DBIx::Class::InflateColumn::DateTime)
- my $val = $row->get_inflated_column('last_modified');
- my $val = $row->last_modified;
+ my $val = $result->get_inflated_column('last_modified');
+ my $val = $result->last_modified;
- $row->set_inflated_column('last_modified' => $val);
- $row->last_modified($val);
+ $result->set_inflated_column('last_modified' => $val);
+ $result->last_modified($val);
=over
=head2 insert
- $row->insert;
+ $result->insert;
=over
sub insert {
my ($self) = @_;
return $self if $self->in_storage;
- my $source = $self->result_source;
+ my $rsrc = $self->result_source;
$self->throw_exception("No result_source set on this object; can't insert")
- unless $source;
+ unless $rsrc;
- my $storage = $source->storage;
+ my $storage = $rsrc->schema->storage;
my $rollback_guard;
# insert what needs to be inserted before us
my %pre_insert;
- for my $relname (keys %related_stuff) {
- my $rel_obj = $related_stuff{$relname};
+ for my $rel_name (keys %related_stuff) {
+ my $rel_obj = $related_stuff{$rel_name};
- if (! $self->{_rel_in_storage}{$relname}) {
- next unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row'));
+ if (! $self->{_rel_in_storage}{$rel_name}) {
+ next unless (blessed $rel_obj && $rel_obj->isa(__PACKAGE__));
- next unless $source->_pk_depends_on(
- $relname, { $rel_obj->get_columns }
+ next unless $rsrc->_pk_depends_on(
+ $rel_name, { $rel_obj->get_columns }
);
# The guard will save us if we blow out of this scope via die
$rollback_guard ||= $storage->txn_scope_guard;
- MULTICREATE_DEBUG and warn "MC $self pre-reconstructing $relname $rel_obj\n";
+ MULTICREATE_DEBUG and print STDERR "MC $self pre-reconstructing $rel_name $rel_obj\n";
my $them = { %{$rel_obj->{_relationship_data} || {} }, $rel_obj->get_columns };
my $existing;
# if there are no keys - nothing to search for
- if (keys %$them and $existing = $self->result_source
- ->related_source($relname)
+ if (keys %$them and $existing = $rsrc->related_source($rel_name)
->resultset
->find($them)
) {
$rel_obj->insert;
}
- $self->{_rel_in_storage}{$relname} = 1;
+ $self->{_rel_in_storage}{$rel_name} = 1;
}
- $self->set_from_related($relname, $rel_obj);
- delete $related_stuff{$relname};
+ $self->set_from_related($rel_name, $rel_obj);
+ delete $related_stuff{$rel_name};
}
# start a transaction here if not started yet and there is more stuff
MULTICREATE_DEBUG and do {
no warnings 'uninitialized';
- warn "MC $self inserting (".join(', ', $self->get_columns).")\n";
+ print STDERR "MC $self inserting (".join(', ', $self->get_columns).")\n";
};
# perform the insert - the storage will return everything it is asked to
# (autoinc primary columns and any retrieve_on_insert columns)
my %current_rowdata = $self->get_columns;
my $returned_cols = $storage->insert(
- $source,
+ $rsrc,
{ %current_rowdata }, # what to insert, copy because the storage *will* change it
);
or
(defined $current_rowdata{$_} xor defined $returned_cols->{$_})
or
- (defined $current_rowdata{$_} and $current_rowdata{$_} ne $returned_cols->{$_})
+ (
+ defined $current_rowdata{$_}
+ and
+ # one of the few spots doing forced-stringification
+ # needed to work around objects with defined stringification
+ # but *without* overloaded comparison (ugh!)
+ "$current_rowdata{$_}" ne "$returned_cols->{$_}"
+ )
);
}
$self->{_dirty_columns} = {};
$self->{related_resultsets} = {};
- foreach my $relname (keys %related_stuff) {
- next unless $source->has_relationship ($relname);
+ foreach my $rel_name (keys %related_stuff) {
+ next unless $rsrc->has_relationship ($rel_name);
- my @cands = ref $related_stuff{$relname} eq 'ARRAY'
- ? @{$related_stuff{$relname}}
- : $related_stuff{$relname}
+ my @cands = ref $related_stuff{$rel_name} eq 'ARRAY'
+ ? @{$related_stuff{$rel_name}}
+ : $related_stuff{$rel_name}
;
- if (@cands && blessed $cands[0] && $cands[0]->isa('DBIx::Class::Row')
+ if (@cands && blessed $cands[0] && $cands[0]->isa(__PACKAGE__)
) {
- my $reverse = $source->reverse_relationship_info($relname);
+ my $reverse = $rsrc->reverse_relationship_info($rel_name);
foreach my $obj (@cands) {
$obj->set_from_related($_, $self) for keys %$reverse;
- if ($self->__their_pk_needs_us($relname)) {
- if (exists $self->{_ignore_at_insert}{$relname}) {
- MULTICREATE_DEBUG and warn "MC $self skipping post-insert on $relname";
+ if ($self->__their_pk_needs_us($rel_name)) {
+ if (exists $self->{_ignore_at_insert}{$rel_name}) {
+ MULTICREATE_DEBUG and print STDERR "MC $self skipping post-insert on $rel_name\n";
}
else {
- MULTICREATE_DEBUG and warn "MC $self inserting $relname $obj";
+ MULTICREATE_DEBUG and print STDERR "MC $self inserting $rel_name $obj\n";
$obj->insert;
}
} else {
- MULTICREATE_DEBUG and warn "MC $self post-inserting $obj";
+ MULTICREATE_DEBUG and print STDERR "MC $self post-inserting $obj\n";
$obj->insert();
}
}
=head2 in_storage
- $row->in_storage; # Get value
- $row->in_storage(1); # Set value
+ $result->in_storage; # Get value
+ $result->in_storage(1); # Set value
=over
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.
-=cut
-
-sub in_storage {
- my ($self, $val) = @_;
- $self->{_in_storage} = $val if @_ > 1;
- return $self->{_in_storage} ? 1 : 0;
-}
=head2 update
- $row->update(\%columns?)
+ $result->update(\%columns?)
=over
=back
Throws an exception if the result object is not yet in the database,
-according to L</in_storage>.
+according to L</in_storage>. Returns the object itself.
This method issues an SQL UPDATE query to commit any changes to the
object to the database if required (see L</get_dirty_columns>).
If the values passed or any of the column values set on the object
contain scalar references, e.g.:
- $row->last_modified(\'NOW()')->update();
+ $result->last_modified(\'NOW()')->update();
# OR
- $row->update({ last_modified => \'NOW()' });
+ $result->update({ last_modified => \'NOW()' });
The update will pass the values verbatim into SQL. (See
L<SQL::Abstract> docs). The values in your Result object will NOT change
with the actual values from the database, call L</discard_changes>
after the update.
- $row->update()->discard_changes();
+ $result->update()->discard_changes();
To determine before calling this method, which column values have
changed and will be updated, call L</get_dirty_columns>.
$self->throw_exception( "Not in database" ) unless $self->in_storage;
- my $rows = $self->result_source->storage->update(
+ my $rows = $self->result_source->schema->storage->update(
$self->result_source, \%to_update, $self->_storage_ident_condition
);
if ($rows == 0) {
=head2 delete
- $row->delete
+ $result->delete
=over
if (ref $self) {
$self->throw_exception( "Not in database" ) unless $self->in_storage;
- $self->result_source->storage->delete(
+ $self->result_source->schema->storage->delete(
$self->result_source, $self->_storage_ident_condition
);
delete $self->{_column_data_in_storage};
- $self->in_storage(undef);
+ $self->in_storage(0);
}
else {
- my $rsrc = try { $self->result_source_instance }
- or $self->throw_exception("Can't do class delete without a ResultSource instance");
-
- my $attrs = @_ > 1 && ref $_[$#_] eq 'HASH' ? { %{pop(@_)} } : {};
+ my $attrs = @_ > 1 && ref $_[-1] eq 'HASH' ? { %{pop(@_)} } : {};
my $query = ref $_[0] eq 'HASH' ? $_[0] : {@_};
- $rsrc->resultset->search(@_)->delete;
+ $self->result_source->resultset->search_rs(@_)->delete;
}
return $self;
}
=head2 get_column
- my $val = $row->get_column($col);
+ my $val = $result->get_column($col);
=over
Note that if you used the C<columns> or the C<select/as>
L<search attributes|DBIx::Class::ResultSet/ATTRIBUTES> on the resultset from
-which C<$row> was derived, and B<did not include> C<$columnname> in the list,
+which C<$result> was derived, and B<did not include> C<$columnname> in the list,
this method will return C<undef> even if the database contains some value.
To retrieve all loaded column values as a hash, use L</get_columns>.
sub get_column {
my ($self, $column) = @_;
$self->throw_exception( "Can't fetch data as class method" ) unless ref $self;
- return $self->{_column_data}{$column} if exists $self->{_column_data}{$column};
+
+ return $self->{_column_data}{$column}
+ if exists $self->{_column_data}{$column};
+
if (exists $self->{_inflated_column}{$column}) {
- return $self->store_column($column,
- $self->_deflated_column($column, $self->{_inflated_column}{$column}));
+ # deflate+return cycle
+ return $self->store_column($column, $self->_deflated_column(
+ $column, $self->{_inflated_column}{$column}
+ ));
}
- $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;
}
=head2 has_column_loaded
- if ( $row->has_column_loaded($col) ) {
+ if ( $result->has_column_loaded($col) ) {
print "$col has been loaded from db";
}
sub has_column_loaded {
my ($self, $column) = @_;
$self->throw_exception( "Can't call has_column data as class method" ) unless ref $self;
- return 1 if exists $self->{_inflated_column}{$column};
- return exists $self->{_column_data}{$column};
+
+ return (
+ exists $self->{_inflated_column}{$column}
+ or
+ exists $self->{_column_data}{$column}
+ ) ? 1 : 0;
}
=head2 get_columns
- my %data = $row->get_columns;
+ my %data = $result->get_columns;
=over
sub get_columns {
my $self = shift;
if (exists $self->{_inflated_column}) {
+ # deflate cycle for each inflation, including filter rels
foreach my $col (keys %{$self->{_inflated_column}}) {
- $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}))
- unless exists $self->{_column_data}{$col};
+ unless (exists $self->{_column_data}{$col}) {
+
+ # if cached related_resultset is present assume this was a prefetch
+ carp_unique(
+ "Returning primary keys of prefetched 'filter' rels as part of get_columns() is deprecated and will "
+ . 'eventually be removed entirely (set DBIC_COLUMNS_INCLUDE_FILTER_RELS to disable this warning)'
+ ) if (
+ ! $ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS}
+ and
+ defined $self->{related_resultsets}{$col}
+ and
+ defined $self->{related_resultsets}{$col}->get_cache
+ );
+
+ $self->store_column($col, $self->_deflated_column($col, $self->{_inflated_column}{$col}));
+ }
}
}
return %{$self->{_column_data}};
=head2 get_dirty_columns
- my %data = $row->get_dirty_columns;
+ my %data = $result->get_dirty_columns;
=over
=head2 make_column_dirty
- $row->make_column_dirty($col)
+ $result->make_column_dirty($col)
=over
really changed.
=cut
+
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 %inflated;
- for my $col (keys %$loaded_colinfo) {
- if (exists $loaded_colinfo->{$col}{accessor}) {
- my $acc = $loaded_colinfo->{$col}{accessor};
- $inflated{$col} = $self->$acc if defined $acc;
- }
- else {
- $inflated{$col} = $self->$col;
+ my %cols_to_return = ( %{$self->{_column_data}}, %$loaded_colinfo );
+
+ unless ($ENV{DBIC_COLUMNS_INCLUDE_FILTER_RELS}) {
+ for (keys %$loaded_colinfo) {
+ # if cached related_resultset is present assume this was a prefetch
+ if (
+ $loaded_colinfo->{$_}{_inflate_info}
+ and
+ defined $self->{related_resultsets}{$_}
+ and
+ defined $self->{related_resultsets}{$_}->get_cache
+ ) {
+ carp_unique(
+ "Returning prefetched 'filter' rels as part of get_inflated_columns() is deprecated and will "
+ . 'eventually be removed entirely (set DBIC_COLUMNS_INCLUDE_FILTER_RELS to disable this warning)'
+ );
+ last;
+ }
}
}
- # return all loaded columns with the inflations overlayed on top
- return %{ { $self->get_columns, %inflated } };
+ map { $_ => (
+ (
+ ! exists $loaded_colinfo->{$_}
+ or
+ (
+ exists $loaded_colinfo->{$_}{accessor}
+ and
+ ! defined $loaded_colinfo->{$_}{accessor}
+ )
+ ) ? $self->get_column($_)
+ : $self->${ \(
+ defined $loaded_colinfo->{$_}{accessor}
+ ? $loaded_colinfo->{$_}{accessor}
+ : $_
+ )}
+ )} keys %cols_to_return;
}
sub _is_column_numeric {
- my ($self, $column) = @_;
- my $colinfo = $self->column_info ($column);
+ my ($self, $column) = @_;
+
+ my $rsrc;
+
+ return undef
+ unless ( $rsrc = $self->result_source )->has_column($column);
+
+ my $colinfo = $rsrc->columns_info->{$column};
# cache for speed (the object may *not* have a resultsource instance)
if (
! defined $colinfo->{is_numeric}
and
- my $storage = try { $self->result_source->schema->storage }
+ my $storage = dbic_internal_try { $rsrc->schema->storage }
) {
$colinfo->{is_numeric} =
$storage->is_datatype_numeric ($colinfo->{data_type})
=head2 set_column
- $row->set_column($col => $val);
+ $result->set_column($col => $val);
=over
my ($self, $column, $new_value) = @_;
my $had_value = $self->has_column_loaded($column);
- my ($old_value, $in_storage) = ($self->get_column($column), $self->in_storage)
- if $had_value;
+ my $old_value = $self->get_column($column);
$new_value = $self->store_column($column, $new_value);
my $dirty =
$self->{_dirty_columns}{$column}
||
- $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) {
#
# FIXME - this is a quick *largely incorrect* hack, pending a more
# serious rework during the merge of single and filter rels
- my $rels = $self->result_source->{_relationships};
- for my $rel (keys %$rels) {
+ my $rel_names = $self->result_source->{_relationships};
+ for my $rel_name (keys %$rel_names) {
- my $acc = $rels->{$rel}{attrs}{accessor} || '';
+ my $acc = $rel_names->{$rel_name}{attrs}{accessor} || '';
- if ( $acc eq 'single' and $rels->{$rel}{attrs}{fk_columns}{$column} ) {
- delete $self->{related_resultsets}{$rel};
- delete $self->{_relationship_data}{$rel};
- #delete $self->{_inflated_column}{$rel};
+ if ( $acc eq 'single' and $rel_names->{$rel_name}{attrs}{fk_columns}{$column} ) {
+ delete $self->{related_resultsets}{$rel_name};
+ delete $self->{_relationship_data}{$rel_name};
+ #delete $self->{_inflated_column}{$rel_name};
}
- elsif ( $acc eq 'filter' and $rel eq $column) {
- delete $self->{related_resultsets}{$rel};
- #delete $self->{_relationship_data}{$rel};
- delete $self->{_inflated_column}{$rel};
+ elsif ( $acc eq 'filter' and $rel_name eq $column) {
+ delete $self->{related_resultsets}{$rel_name};
+ #delete $self->{_relationship_data}{$rel_name};
+ delete $self->{_inflated_column}{$rel_name};
}
}
$had_value
and
# no storage - no storage-value
- $in_storage
+ $self->in_storage
and
# no value already stored (multiple changes before commit to storage)
! exists $self->{_column_data_in_storage}{$column}
elsif (not defined $old) { # both undef
return 1;
}
+ elsif (
+ is_literal_value $old
+ or
+ is_literal_value $new
+ ) {
+ return 0;
+ }
elsif ($old eq $new) {
return 1;
}
# 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 scalar grep
+ { $col eq $_ }
+ $self->result_source->primary_columns
+ ;
}
=head2 set_columns
- $row->set_columns({ $col => $val, ... });
+ $result->set_columns({ $col => $val, ... });
=over
=cut
sub set_columns {
- my ($self,$data) = @_;
- foreach my $col (keys %$data) {
- $self->set_column($col,$data->{$col});
- }
+ my ($self, $values) = @_;
+ $self->set_column( $_, $values->{$_} ) for keys %$values;
return $self;
}
=head2 set_inflated_columns
- $row->set_inflated_columns({ $col => $val, $relname => $obj, ... });
+ $result->set_inflated_columns({ $col => $val, $rel_name => $obj, ... });
=over
sub set_inflated_columns {
my ( $self, $upd ) = @_;
+
+ my ($rsrc, $colinfos);
+
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') {
- my $rel = delete $upd->{$key};
- $self->set_from_related($key => $rel);
- $self->{_relationship_data}{$key} = $rel;
+ my $rel_obj = delete $upd->{$key};
+ $self->set_from_related($key => $rel_obj);
+ $self->{_relationship_data}{$key} = $rel_obj;
}
elsif ($acc_type eq 'multi') {
$self->throw_exception(
"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 (
+ exists( (
+ ( $colinfos ||= $rsrc->columns_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_instance($rsrc);
$new->set_inflated_columns($changes);
$new->insert;
# Its possible we'll have 2 relations to the same Source. We need to make
# sure we don't try to insert the same row twice else we'll violate unique
# constraints
- my $rels_copied = {};
+ my $rel_names_copied = {};
- foreach my $rel ($self->result_source->relationships) {
- my $rel_info = $self->result_source->relationship_info($rel);
+ 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(
- $rel_info->{cond}, $rel, $new, $rel
- );
+ my $foreign_vals;
+ my $copied = $rel_names_copied->{ $rel_info->{source} } ||= {};
- my $copied = $rels_copied->{ $rel_info->{source} } ||= {};
- foreach my $related ($self->search_related($rel)) {
- my $id_str = join("\0", $related->id);
- next if $copied->{$id_str};
- $copied->{$id_str} = 1;
- my $rel_copy = $related->copy($resolved);
- }
+ $copied->{$_->ID}++ or $_->copy(
+
+ $foreign_vals ||= $rsrc->_resolve_relationship_condition(
+ infer_values_based_on => {},
+ rel_name => $rel_name,
+ self_result_object => $new,
+ self_alias => "\xFE", # irrelevant
+ foreign_alias => "\xFF", # irrelevant,
+ )->{inferred_values}
+
+ ) for $self->related_resultset($rel_name)->all;
}
return $new;
}
=head2 store_column
- $row->store_column($col => $val);
+ $result->store_column($col => $val);
=over
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;
+
+ my $vref;
+ $self->{_column_data}{$column} = (
+ # unpack potential { -value => "foo" }
+ ( length ref $value and $vref = is_plain_value( $value ) )
+ ? $$vref
+ : $value
+ );
}
=head2 inflate_result
=cut
sub inflate_result {
- my ($class, $source, $me, $prefetch) = @_;
-
- $source = $source->resolve
- if $source->isa('DBIx::Class::ResultSourceHandle');
+ my ($class, $rsrc, $me, $prefetch) = @_;
my $new = bless
- { _column_data => $me, _result_source => $source },
+ { _column_data => $me, _result_source => $rsrc },
ref $class || $class
;
- foreach my $pre (keys %{$prefetch||{}}) {
+ if ($prefetch) {
+ for my $rel_name ( keys %$prefetch ) {
- my (@pre_vals, $is_multi);
- if (ref $prefetch->{$pre}[0] eq 'ARRAY') {
- $is_multi = 1;
- @pre_vals = @{$prefetch->{$pre}};
- }
- else {
- @pre_vals = $prefetch->{$pre};
- }
-
- my $pre_source = try {
- $source->related_source($pre)
- }
- catch {
- $class->throw_exception(sprintf
+ my $relinfo = $rsrc->relationship_info($rel_name) or do {
+ my $err = sprintf
+ "Inflation into non-existent relationship '%s' of '%s' requested",
+ $rel_name,
+ $rsrc->source_name,
+ ;
+ if (my ($colname) = sort { length($a) <=> length ($b) } keys %{$prefetch->{$rel_name}[0] || {}} ) {
+ $err .= sprintf ", check the inflation specification (columns/as) ending in '...%s.%s'",
+ $rel_name,
+ $colname,
+ }
- "Can't inflate manual prefetch into non-existent relationship '%s' from '%s', "
- . "check the inflation specification (columns/as) ending in '%s.%s'.",
+ $rsrc->throw_exception($err);
+ };
- $pre,
- $source->source_name,
- $pre,
- (keys %{$pre_vals[0][0]})[0] || 'something.something...',
- );
- };
+ $class->throw_exception("No accessor type declared for prefetched relationship '$rel_name'")
+ unless $relinfo->{attrs}{accessor};
- my $accessor = $source->relationship_info($pre)->{attrs}{accessor}
- or $class->throw_exception("No accessor type declared for prefetched $pre");
+ my $rel_rs = $new->related_resultset($rel_name);
- if (! $is_multi and $accessor eq 'multi') {
- $class->throw_exception("Manual prefetch (via select/columns) not supported with accessor 'multi'");
- }
+ my @rel_objects;
+ if (
+ @{ $prefetch->{$rel_name} || [] }
+ and
+ ref($prefetch->{$rel_name}) ne $DBIx::Class::ResultSource::RowParser::Util::null_branch_class
+ ) {
- my @pre_objects;
- for my $me_pref (@pre_vals) {
-
- # FIXME - this should not be necessary
- # the collapser currently *could* return bogus elements with all
- # columns set to undef
- my $has_def;
- for (values %{$me_pref->[0]}) {
- if (defined $_) {
- $has_def++;
- last;
- }
+ if (ref $prefetch->{$rel_name}[0] eq 'ARRAY') {
+ my $rel_rsrc = $rel_rs->result_source;
+ my $rel_class = $rel_rs->result_class;
+ my $rel_inflator = $rel_class->can('inflate_result');
+ @rel_objects = map
+ { $rel_class->$rel_inflator ( $rel_rsrc, @$_ ) }
+ @{$prefetch->{$rel_name}}
+ ;
}
- next unless $has_def;
+ else {
+ @rel_objects = $rel_rs->result_class->inflate_result(
+ $rel_rs->result_source, @{$prefetch->{$rel_name}}
+ );
+ }
+ }
- push @pre_objects, $pre_source->result_class->inflate_result(
- $pre_source, @$me_pref
- );
- }
+ if ($relinfo->{attrs}{accessor} eq 'single') {
+ $new->{_relationship_data}{$rel_name} = $rel_objects[0];
+ }
+ elsif ($relinfo->{attrs}{accessor} eq 'filter') {
+ $new->{_inflated_column}{$rel_name} = $rel_objects[0];
+ }
- if ($accessor eq 'single') {
- $new->{_relationship_data}{$pre} = $pre_objects[0];
+ $rel_rs->set_cache(\@rel_objects);
}
- elsif ($accessor eq 'filter') {
- $new->{_inflated_column}{$pre} = $pre_objects[0];
- }
-
- $new->related_resultset($pre)->set_cache(\@pre_objects);
}
$new->in_storage (1);
=head2 update_or_insert
- $row->update_or_insert
+ $result->update_or_insert
=over
=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
=cut
-sub insert_or_update { shift->update_or_insert(@_) }
+sub insert_or_update :DBIC_method_is_indirect_sugar {
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS and fail_on_internal_call;
+ shift->update_or_insert(@_);
+}
sub update_or_insert {
my $self = shift;
=head2 is_changed
- my @changed_col_names = $row->is_changed();
- if ($row->is_changed()) { ... }
+ my @changed_col_names = $result->is_changed();
+ if ($result->is_changed()) { ... }
=over
=head2 is_column_changed
- if ($row->is_column_changed('col')) { ... }
+ if ($result->is_column_changed('col')) { ... }
=over
=head2 result_source
- my $resultsource = $row->result_source;
+ my $resultsource = $result->result_source;
=over
=cut
-sub result_source {
- $_[0]->throw_exception( 'result_source can be called on instances only' )
- unless ref $_[0];
-
+sub result_source :DBIC_method_is_indirect_sugar {
+ # While getter calls are routed through here for sensible exception text
+ # it makes no sense to have setters do the same thing
+ DBIx::Class::_ENV_::ASSERT_NO_INTERNAL_INDIRECT_CALLS
+ and
@_ > 1
- ? $_[0]->{_result_source} = $_[1]
-
- # note this is a || not a ||=, the difference is important
- : $_[0]->{_result_source} || do {
- my $class = ref $_[0];
- $_[0]->can('result_source_instance')
- ? $_[0]->result_source_instance
- : $_[0]->throw_exception(
- "No result source instance registered for $class, did you forget to call $class->table(...) ?"
- )
- }
- ;
+ and
+ fail_on_internal_call;
+
+ # this is essentially a `shift->result_source_instance(@_)` with handholding
+ &{
+ $_[0]->can('result_source_instance')
+ ||
+ $_[0]->throw_exception(
+ "No ResultSource instance registered for '@{[ $_[0] ]}', did you forget to call @{[ ref $_[0] || $_[0] ]}->table(...) ?"
+ )
+ };
}
=head2 register_column
=head2 get_from_storage
- my $copy = $row->get_from_storage($attrs)
+ my $copy = $result->get_from_storage($attrs)
=over
=head2 discard_changes
- $row->discard_changes
+ $result->discard_changes
=over
second argument to C<< $resultset->search($cond, $attrs) >>;
Note: If you are using L<DBIx::Class::Storage::DBI::Replicated> as your
-storage, please kept in mind that if you L</discard_changes> on a row that you
-just updated or created, you should wrap the entire bit inside a transaction.
-Otherwise you run the risk that you insert or update to the master database
-but read from a replicant database that has not yet been updated from the
-master. This will result in unexpected results.
+storage, a default of
+L<< C<< { force_pool => 'master' } >>
+|DBIx::Class::Storage::DBI::Replicated/SYNOPSIS >> is automatically set for
+you. Prior to C<< DBIx::Class 0.08109 >> (before 2010) one would have been
+required to explicitly wrap the entire operation in a transaction to guarantee
+that up-to-date results are read from the master database.
=cut
sub throw_exception {
my $self=shift;
- if (ref $self && ref $self->result_source ) {
- $self->result_source->throw_exception(@_)
+ if (
+ ! DBIx::Class::_Util::in_internal_try
+ and
+ # FIXME - the try is 99% superfluous, but just in case
+ my $rsrc = dbic_internal_try { $self->result_source_instance }
+ ) {
+ $rsrc->throw_exception(@_)
}
else {
DBIx::Class::Exception->throw(@_);
=head2 id
- my @pk = $row->id;
+ my @pk = $result->id;
=over
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