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;
restriction. This is currently only used to create tables from your
schema, see L<DBIx::Class::Schema/deploy>.
+ { size => [ 9, 6 ] }
+
+For decimal or float values you can specify an ArrayRef in order to
+control precision, assuming your database's
+L<SQL::Translator::Producer> supports it.
+
=item is_nullable
{ is_nullable => 1 }
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
- first { $rel_info->{attrs}{accessor} eq $_ } (qw/single filter/)
+ $rel_info->{attrs}{accessor} eq 'single'
+ or
+ $rel_info->{attrs}{accessor} eq 'filter'
),
-alias => $as,
-relation_chain_depth => ( $seen->{-relation_chain_depth} || 0 ) + 1,
},
- scalar $self->_resolve_condition($rel_info->{cond}, $as, $alias, $join)
+ $self->_resolve_relationship_condition(
+ rel_name => $join,
+ self_alias => $alias,
+ foreign_alias => $as,
+ )->{condition},
];
}
}
}
my $args = {
- condition => $cond,
-
# where-is-waldo block guesses relname, then further down we override it if available
(
$is_objlike[1] ? ( rel_name => $res_args[0], self_alias => $res_args[0], foreign_alias => 'me', self_result_object => $res_args[1] )
( $rel_name ? ( rel_name => $rel_name ) : () ),
};
+
+ # Allowing passing relconds different than the relationshup itself is cute,
+ # but likely dangerous. Remove that from the (still unofficial) API of
+ # _resolve_relationship_condition, and instead make it "hard on purpose"
+ local $self->relationship_info( $args->{rel_name} )->{cond} = $cond if defined $cond;
+
#######################
# now it's fucking easy isn't it?!
# self_result_object => (either not supplied or a result object)
# require_join_free_condition => (boolean, throws on failure to construct a JF-cond)
# infer_values_based_on => (either not supplied or a hashref, implies require_join_free_condition)
-# condition => (sqla cond struct, optional, defeaults to from $self->rel_info(rel_name)->{cond})
#
## returns a hash
# condition => (a valid *likely fully qualified* sqla cond structure)
$args->{require_join_free_condition} ||= !!$args->{infer_values_based_on};
- $args->{condition} ||= $rel_info->{cond};
-
$self->throw_exception( "Argument 'self_result_object' must be an object inheriting from DBIx::Class::Row" )
if (
exists $args->{self_result_object}
)
;
-#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(
my $ret;
- if (ref $args->{condition} eq 'CODE') {
+ if (ref $rel_info->{cond} eq 'CODE') {
my $cref_args = {
rel_name => $args->{rel_name},
$cref_args->{self_rowobj} = $cref_args->{self_result_object}
if exists $cref_args->{self_result_object};
- ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $args->{condition}->($cref_args);
+ ($ret->{condition}, $ret->{join_free_condition}, my @extra) = $rel_info->{cond}->($cref_args);
# sanity check
$self->throw_exception("A custom condition coderef can return at most 2 conditions, but $exception_rel_id returned extra values: @extra")
"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;
(
}
}
- elsif (ref $args->{condition} eq 'HASH') {
+ elsif (ref $rel_info->{cond} eq 'HASH') {
# the condition is static - use parallel arrays
# for a "pivot" depending on which side of the
# rel did we get as an object
my (@f_cols, @l_cols);
- for my $fc (keys %{$args->{condition}}) {
- my $lc = $args->{condition}{$fc};
+ for my $fc (keys %{ $rel_info->{cond} }) {
+ my $lc = $rel_info->{cond}{$fc};
# FIXME STRICTMODE should probably check these are valid columns
$fc =~ s/^foreign\.// ||
}
}
}
- elsif (ref $args->{condition} eq 'ARRAY') {
- if (@{$args->{condition}} == 0) {
+ elsif (ref $rel_info->{cond} eq 'ARRAY') {
+ if (@{ $rel_info->{cond} } == 0) {
$ret = {
condition => UNRESOLVABLE_CONDITION,
join_free_condition => UNRESOLVABLE_CONDITION,
};
}
- elsif (@{$args->{condition}} == 1) {
- $ret = $self->_resolve_relationship_condition({
- %$args,
- condition => $args->{condition}[0],
- });
- }
else {
- # we are discarding inferred values here... likely incorrect...
- # then again - the entire thing is an OR, so we *can't* use them anyway
- for my $subcond ( map
- { $self->_resolve_relationship_condition({ %$args, condition => $_ }) }
- @{$args->{condition}}
- ) {
- $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
- if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
+ my @subconds = map {
+ local $rel_info->{cond} = $_;
+ $self->_resolve_relationship_condition( $args );
+ } @{ $rel_info->{cond} };
- $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
+ if( @{ $rel_info->{cond} } == 1 ) {
+ $ret = $subconds[0];
+ }
+ else {
+ # we are discarding inferred values here... likely incorrect...
+ # then again - the entire thing is an OR, so we *can't* use them anyway
+ for my $subcond ( @subconds ) {
+ $self->throw_exception('Either all or none of the OR-condition members must resolve to a join-free condition')
+ if ( $ret and ( $ret->{join_free_condition} xor $subcond->{join_free_condition} ) );
+
+ $subcond->{$_} and push @{$ret->{$_}}, $subcond->{$_} for (qw(condition join_free_condition));
+ }
}
}
}
else {
- $self->throw_exception ("Can't handle condition $args->{condition} for $exception_rel_id yet :(");
+ $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;
- if ( my $jfc = $ret->{join_free_condition} and $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION ) {
+ if (
+ $ret->{join_free_condition}
+ and
+ $ret->{join_free_condition} ne UNRESOLVABLE_CONDITION
+ and
+ my $jfc = $storage->_collapse_cond( $ret->{join_free_condition} )
+ ) {
my $jfc_eqs = $storage->_extract_fixed_condition_columns($jfc, 'consider_nulls');
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,
my $global_phase_destroy;
sub DESTROY {
- ### NO detect_reinvoked_destructor check
+ ### NO detected_reinvoked_destructor check
### This code very much relies on being called multuple times
return if $global_phase_destroy ||= in_global_destruction;
# 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