use strict;
use warnings;
-use base qw/DBIx::Class::ResultSource::RowParser DBIx::Class/;
-
-use DBIx::Class::ResultSet;
-use DBIx::Class::ResultSourceHandle;
+use base 'DBIx::Class';
+__PACKAGE__->load_components(qw(
+ ResultSource::RowParser
+));
use DBIx::Class::Carp;
-use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
+use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dbic_internal_try );
use SQL::Abstract 'is_literal_value';
use Devel::GlobalDestruction;
-use Try::Tiny;
-use List::Util 'first';
use Scalar::Util qw/blessed weaken isweak/;
use namespace::clean;
if ( ! $self->_columns->{$column}{data_type}
and ! $self->{_columns_info_loaded}
and $self->column_info_from_storage
- and my $stor = try { $self->storage } )
+ and my $stor = dbic_internal_try { $self->storage } )
{
$self->{_columns_info_loaded}++;
# try for the case of storage without table
- try {
+ dbic_internal_try {
my $info = $stor->columns_info_for( $self->from );
my $lc_info = { map
{ (lc $_) => $info->{$_} }
my $colinfo = $self->_columns;
if (
- first { ! $_->{data_type} } values %$colinfo
- and
! $self->{_columns_info_loaded}
and
$self->column_info_from_storage
and
- my $stor = try { $self->storage }
+ grep { ! $_->{data_type} } values %$colinfo
+ and
+ my $stor = dbic_internal_try { $self->storage }
) {
$self->{_columns_info_loaded}++;
# try for the case of storage without table
- try {
+ dbic_internal_try {
my $info = $stor->columns_info_for( $self->from );
my $lc_info = { map
{ (lc $_) => $info->{$_} }
my $self = shift;
my @constraints = @_;
- if ( !(@constraints % 2) && first { ref $_ ne 'ARRAY' } @constraints ) {
+ if ( !(@constraints % 2) && grep { ref $_ ne 'ARRAY' } @constraints ) {
# with constraint name
while (my ($name, $constraint) = splice @constraints, 0, 2) {
$self->add_unique_constraint($name => $constraint);
$self->resultset_class->new(
$self,
{
- try { %{$self->schema->default_resultset_attributes} },
+ ( dbic_internal_try { %{$self->schema->default_resultset_attributes} } ),
%{$self->{resultset_attributes}},
},
);
$self->_relationships(\%rels);
return $self;
-
-# XXX disabled. doesn't work properly currently. skip in tests.
-
- my $f_source = $self->schema->source($f_source_name);
- unless ($f_source) {
- $self->ensure_class_loaded($f_source_name);
- $f_source = $f_source_name->result_source;
- #my $s_class = ref($self->schema);
- #$f_source_name =~ m/^${s_class}::(.*)$/;
- #$self->schema->register_class(($1 || $f_source_name), $f_source_name);
- #$f_source = $self->schema->source($f_source_name);
- }
- return unless $f_source; # Can't test rel without f_source
-
- try { $self->_resolve_join($rel, 'me', {}, []) }
- catch {
- # If the resolve failed, back out and re-throw the error
- delete $rels{$rel};
- $self->_relationships(\%rels);
- $self->throw_exception("Error creating relationship $rel: $_");
- };
-
- 1;
}
=head2 relationships
# to use the source_names, otherwise we will use the actual classes
# the schema may be partial
- my $roundtrip_rsrc = try { $other_rsrc->related_source($other_rel) }
+ my $roundtrip_rsrc = dbic_internal_try { $other_rsrc->related_source($other_rel) }
or next;
if ($registered_source_name) {
,
-join_path => [@$jpath, { $join => $as } ],
-is_single => (
- (! $rel_info->{attrs}{accessor})
+ ! $rel_info->{attrs}{accessor}
+ or
+ $rel_info->{attrs}{accessor} eq 'single'
or
- first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
+ $rel_info->{attrs}{accessor} eq 'filter'
),
-alias => $as,
-relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
)
;
-#TEMP
- my $rel_rsrc;# = $self->related_source($args->{rel_name});
+ my $rel_rsrc = $self->related_source($args->{rel_name});
+ my $storage = $self->schema->storage;
if (exists $args->{foreign_values}) {
-# TEMP
- $rel_rsrc ||= $self->related_source($args->{rel_name});
- if (defined blessed $args->{foreign_values}) {
+ if (! defined $args->{foreign_values} ) {
+ # fallback: undef => {}
+ $args->{foreign_values} = {};
+ }
+ elsif (defined blessed $args->{foreign_values}) {
$self->throw_exception( "Objects supplied as 'foreign_values' ($args->{foreign_values}) must inherit from DBIx::Class::Row" )
unless $args->{foreign_values}->isa('DBIx::Class::Row');
$args->{foreign_values} = { $args->{foreign_values}->get_columns };
}
- elsif (! defined $args->{foreign_values} or ref $args->{foreign_values} eq 'HASH') {
- my $ri = { map { $_ => 1 } $rel_rsrc->relationships };
- my $ci = $rel_rsrc->columns_info;
- ! exists $ci->{$_} and ! exists $ri->{$_} and $self->throw_exception(
- "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'"
- ) for keys %{ $args->{foreign_values} ||= {} };
+ elsif ( ref $args->{foreign_values} eq 'HASH' ) {
+
+ # re-build {foreign_values} excluding identically named rels
+ if( keys %{$args->{foreign_values}} ) {
+
+ my ($col_idx, $rel_idx) = map
+ { { map { $_ => 1 } $rel_rsrc->$_ } }
+ qw( columns relationships )
+ ;
+
+ my $equivalencies = $storage->_extract_fixed_condition_columns(
+ $args->{foreign_values},
+ 'consider nulls',
+ );
+
+ $args->{foreign_values} = { map {
+ # skip if relationship *and* a non-literal ref
+ # this means a multicreate stub was passed in
+ (
+ $rel_idx->{$_}
+ and
+ length ref $args->{foreign_values}{$_}
+ and
+ ! is_literal_value($args->{foreign_values}{$_})
+ )
+ ? ()
+ : ( $_ => (
+ ! $col_idx->{$_}
+ ? $self->throw_exception( "Key '$_' supplied as 'foreign_values' is not a column on related source '@{[ $rel_rsrc->source_name ]}'" )
+ : ( !exists $equivalencies->{$_} or ($equivalencies->{$_}||'') eq UNRESOLVABLE_CONDITION )
+ ? $self->throw_exception( "Value supplied for '...{foreign_values}{$_}' is not a direct equivalence expression" )
+ : $args->{foreign_values}{$_}
+ ))
+ } keys %{$args->{foreign_values}} };
+ }
}
else {
$self->throw_exception(
"The join-free condition returned for $exception_rel_id must be a hash reference"
) unless ref $jfc eq 'HASH';
-# TEMP
- $rel_rsrc ||= $self->related_source($args->{rel_name});
-
my ($joinfree_alias, $joinfree_source);
if (defined $args->{self_result_object}) {
$joinfree_alias = $args->{foreign_alias};
exists $fq_col_list->{$_} or $self->throw_exception (
"The join-free condition returned for $exception_rel_id may only "
. 'contain keys that are fully qualified column names of the corresponding source '
- . "(it returned '$_')"
+ . "'$joinfree_alias' (instead it returned '$_')"
) for keys %$jfc;
(
$self->throw_exception ("Can't handle condition $rel_info->{cond} for $exception_rel_id yet :(");
}
- $self->throw_exception(ucfirst "$exception_rel_id does not resolve to a join-free condition fragment") if (
+ if (
$args->{require_join_free_condition}
and
( ! $ret->{join_free_condition} or $ret->{join_free_condition} eq UNRESOLVABLE_CONDITION )
- );
-
- my $storage = $self->schema->storage;
+ ) {
+ $self->throw_exception(
+ ucfirst sprintf "$exception_rel_id does not resolve to a %sjoin-free condition fragment",
+ exists $args->{foreign_values}
+ ? "'foreign_values'-based reversed-"
+ : ''
+ );
+ }
# we got something back - sanity check and infer values if we can
my @nonvalues;
next if $col_eqs->{$lhs} eq UNRESOLVABLE_CONDITION;
-# TEMP
- $rel_rsrc ||= $self->related_source($args->{rel_name});
-
# there is no way to know who is right and who is left in a cref
# therefore a full blown resolution call, and figure out the
# direction a bit further below
# if we are not registered with a schema - just use the prototype
# however if we do have a schema - ask for the source by name (and
# throw in the process if all fails)
- if (my $schema = try { $self->schema }) {
+ if (my $schema = dbic_internal_try { $self->schema }) {
$schema->source($self->relationship_info($rel)->{source});
}
else {
=cut
sub handle {
+ require DBIx::Class::ResultSourceHandle;
return DBIx::Class::ResultSourceHandle->new({
source_moniker => $_[0]->source_name,
# which will serve as a signal to not try doing anything else
# however beware - on older perls the exception seems randomly untrappable
# due to some weird race condition during thread joining :(((
+ local $SIG{__DIE__} if $SIG{__DIE__};
local $@;
eval {
weaken $_[0]->{schema};
# if schema is still there reintroduce ourselves with strong refs back to us
if ($_[0]->{schema}) {
my $srcregs = $_[0]->{schema}->source_registrations;
- for (keys %$srcregs) {
- next unless $srcregs->{$_};
- $srcregs->{$_} = $_[0] if $srcregs->{$_} == $_[0];
- }
+
+ defined $srcregs->{$_}
+ and
+ $srcregs->{$_} == $_[0]
+ and
+ $srcregs->{$_} = $_[0]
+ and
+ last
+ for keys %$srcregs;
}
1;
$global_phase_destroy = 1;
};
- return;
+ # Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
+ # collected before leaving this scope. Depending on the code above, this
+ # may very well be just a preventive measure guarding future modifications
+ undef;
}
sub STORABLE_freeze { Storable::nfreeze($_[0]->handle) }
projects / dbsrgits/DBIx-Class.git / blobdiff