use base qw/DBIx::Class/;
use Scalar::Util 'blessed';
-use List::Util 'first';
-use Try::Tiny;
+use DBIx::Class::_Util 'dbic_internal_try';
use DBIx::Class::Carp;
-use SQL::Abstract 'is_literal_value';
+use SQL::Abstract qw( is_literal_value is_plain_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>.
my $existing;
# if there are no keys - nothing to search for
- if (keys %$them and $existing = $self->result_source
- ->related_source($rel_name)
+ if (keys %$them and $existing = $rsrc->related_source($rel_name)
->resultset
->find($them)
) {
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->in_storage(0);
}
else {
- my $rsrc = try { $self->result_source_instance }
+ my $rsrc = dbic_internal_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(@_)} } : {};
sub _is_column_numeric {
my ($self, $column) = @_;
- return undef unless $self->result_source->has_column($column);
+ my $rsrc;
- my $colinfo = $self->result_source->column_info ($column);
+ return undef
+ unless ( $rsrc = $self->result_source )->has_column($column);
+
+ my $colinfo = $rsrc->column_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})
# value tracked between column changes and commitment to storage
sub _track_storage_value {
my ($self, $col) = @_;
- return defined first { $col eq $_ } ($self->result_source->primary_columns);
+ return scalar grep
+ { $col eq $_ }
+ $self->result_source->primary_columns
+ ;
}
=head2 set_columns
sub copy {
my ($self, $changes) = @_;
$changes ||= {};
- my $col_data = { %{$self->{_column_data}} };
+ my $col_data = { $self->get_columns };
my $rsrc = $self->result_source;
- my $colinfo = $rsrc->columns_info([ keys %$col_data ]);
+ 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 };
next unless $rel_info->{attrs}{cascade_copy};
- my $resolved = $rsrc->_resolve_condition(
- $rel_info->{cond}, $rel_name, $new, $rel_name
- );
-
+ my $foreign_vals;
my $copied = $rel_names_copied->{ $rel_info->{source} } ||= {};
- foreach my $related ($self->search_related($rel_name)->all) {
- $related->copy($resolved)
- unless $copied->{$related->ID}++;
- }
+ $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->search_related($rel_name)->all;
}
return $new;
}
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;
+
+ return $self->{_column_data}{$column} = $value
+ unless length ref $value and my $vref = is_plain_value( $value );
+
+ # if we are dealing with a value/ref - there are a couple possibilities
+ # unpack the underlying piece of data and stringify all objects explicitly
+ # ( to accomodate { -value => ... } and guard against overloaded objects
+ # with defined stringification AND fallback => 0 (ugh!)
+ $self->{_column_data}{$column} = defined blessed $$vref
+ ? "$$vref"
+ : $$vref
+ ;
}
=head2 inflate_result
=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
# 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(...) ?"
+ "No result source instance registered for @{[ ref $_[0] ]}, did you forget to call @{[ ref $_[0] ]}->table(...) ?"
)
}
;
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
+ my $rsrc = dbic_internal_try { $self->result_source }
+ ) {
+ $rsrc->throw_exception(@_)
}
else {
DBIx::Class::Exception->throw(@_);
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