use base qw/DBIx::Class/;
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 '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>.
$rsrc ||= $h->resolve;
}
- $new->result_source($rsrc) if $rsrc;
+ $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} and ! is_literal_value($attrs->{$key}) ) {
next;
}
elsif (
- $rsrc->has_column($key)
- and
- $rsrc->column_info($key)->{_inflate_info}
+ ( $colinfos ||= $rsrc->columns_info )
+ ->{$key}{_inflate_info}
) {
$inflated->{$key} = $attrs->{$key};
next;
$self->throw_exception("No result_source set on this object; can't insert")
unless $rsrc;
- my $storage = $rsrc->storage;
+ my $storage = $rsrc->schema->storage;
my $rollback_guard;
my $rel_obj = $related_stuff{$rel_name};
if (! $self->{_rel_in_storage}{$rel_name}) {
- next unless (blessed $rel_obj && $rel_obj->isa('DBIx::Class::Row'));
+ next unless (blessed $rel_obj && $rel_obj->isa(__PACKAGE__));
next unless $rsrc->_pk_depends_on(
$rel_name, { $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($rel_name)
+ if (keys %$them and $existing = $rsrc->related_source($rel_name)
->resultset
->find($them)
) {
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->{$_}"
+ )
);
}
: $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 = $rsrc->reverse_relationship_info($rel_name);
foreach my $obj (@cands) {
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( "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) {
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
);
$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;
}
sub _is_column_numeric {
my ($self, $column) = @_;
- return undef unless $self->result_source->has_column($column);
+ my $rsrc;
+
+ return undef
+ unless ( $rsrc = $self->result_source )->has_column($column);
- my $colinfo = $self->result_source->column_info ($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})
# 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 set_inflated_columns {
my ( $self, $upd ) = @_;
- my $rsrc;
+
+ my ($rsrc, $colinfos);
+
foreach my $key (keys %$upd) {
if (ref $upd->{$key}) {
$rsrc ||= $self->result_source;
);
}
elsif (
- $rsrc->has_column($key)
- and
- exists $rsrc->column_info($key)->{_inflate_info}
+ 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 $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 };
bless $new, ref $self;
- $new->result_source($rsrc);
+ $new->result_source_instance($rsrc);
$new->set_inflated_columns($changes);
$new->insert;
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) {
- 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;
}
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
=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;
=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
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(@_);
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