use Scalar::Util 'blessed';
use List::Util 'first';
use Try::Tiny;
+use DBIx::Class::Carp;
+use DBIx::Class::_Util 'is_literal_value';
###
### Internal method
=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>.
=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
my ($related,$inflated);
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 $rsrc;
# 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
=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
=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>.
=head2 delete
- $row->delete
+ $result->delete
=over
=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}'" )
+ unless $self->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
grep { $self->has_column_loaded($_) } $self->columns
]);
- 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 {
=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
;
$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;
}
=head2 set_columns
- $row->set_columns({ $col => $val, ... });
+ $result->set_columns({ $col => $val, ... });
=over
=head2 set_inflated_columns
- $row->set_inflated_columns({ $col => $val, $relname => $obj, ... });
+ $result->set_inflated_columns({ $col => $val, $relname => $obj, ... });
=over
if (ref $upd->{$key}) {
my $info = $self->relationship_info($key);
my $acc_type = $info->{attrs}{accessor} || '';
+
if ($acc_type eq 'single') {
my $rel_obj = delete $upd->{$key};
$self->set_from_related($key => $rel_obj);
);
my $copied = $relnames_copied->{ $rel_info->{source} } ||= {};
- foreach my $related ($self->search_related($relname)) {
+ foreach my $related ($self->search_related($relname)->all) {
my $id_str = join("\0", $related->id);
next if $copied->{$id_str};
$copied->{$id_str} = 1;
=head2 store_column
- $row->store_column($col => $val);
+ $result->store_column($col => $val);
=over
if ($prefetch) {
for my $relname ( keys %$prefetch ) {
+ my $relinfo = $rsrc->relationship_info($relname) or do {
+ my $err = sprintf
+ "Inflation into non-existent relationship '%s' of '%s' requested",
+ $relname,
+ $rsrc->source_name,
+ ;
+ if (my ($colname) = sort { length($a) <=> length ($b) } keys %{$prefetch->{$relname}[0] || {}} ) {
+ $err .= sprintf ", check the inflation specification (columns/as) ending in '...%s.%s'",
+ $relname,
+ $colname,
+ }
+
+ $rsrc->throw_exception($err);
+ };
+
+ $class->throw_exception("No accessor type declared for prefetched relationship '$relname'")
+ unless $relinfo->{attrs}{accessor};
+
+ my $rel_rs = $new->related_resultset($relname);
+
my @rel_objects;
if (
- $prefetch->{$relname}
- and
- @{$prefetch->{$relname}}
+ @{ $prefetch->{$relname} || [] }
and
ref($prefetch->{$relname}) ne $DBIx::Class::ResultSource::RowParser::Util::null_branch_class
) {
- my $rel_rsrc = try {
- $rsrc->related_source($relname)
- } catch {
- my $err = sprintf
- "Inflation into non-existent relationship '%s' of '%s' requested",
- $relname,
- $rsrc->source_name,
- ;
- if (my ($colname) = sort { length($a) <=> length ($b) } keys %{$prefetch->{$relname}[0] || {}} ) {
- $err .= sprintf ", check the inflation specification (columns/as) ending in '...%s.%s'",
- $relname,
- $colname,
- }
-
- $rsrc->throw_exception($err);
- };
- @rel_objects = map {
- $rel_rsrc->result_class->inflate_result( $rel_rsrc, @$_ )
- } ( ref $prefetch->{$relname}[0] eq 'ARRAY' ? @{$prefetch->{$relname}} : $prefetch->{$relname} );
+ if (ref $prefetch->{$relname}[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->{$relname}}
+ ;
+ }
+ else {
+ @rel_objects = $rel_rs->result_class->inflate_result(
+ $rel_rs->result_source, @{$prefetch->{$relname}}
+ );
+ }
}
- my $accessor = $rsrc->relationship_info($relname)->{attrs}{accessor}
- or $class->throw_exception("No accessor type declared for prefetched relationship '$relname'");
-
- if ($accessor eq 'single') {
+ if ($relinfo->{attrs}{accessor} eq 'single') {
$new->{_relationship_data}{$relname} = $rel_objects[0];
}
- elsif ($accessor eq 'filter') {
+ elsif ($relinfo->{attrs}{accessor} eq 'filter') {
$new->{_inflated_column}{$relname} = $rel_objects[0];
}
- $new->related_resultset($relname)->set_cache(\@rel_objects);
+ $rel_rs->set_cache(\@rel_objects);
}
}
=head2 update_or_insert
- $row->update_or_insert
+ $result->update_or_insert
=over
=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
=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
=head2 id
- my @pk = $row->id;
+ my @pk = $result->id;
=over