package # hide from PAUSE
DBIx::Class::_Util;
+use DBIx::Class::StartupCheck; # load es early as we can, usually a noop
+
use warnings;
use strict;
use Carp 'croak';
use Storable 'nfreeze';
use Scalar::Util qw(weaken blessed reftype refaddr);
-use List::Util qw(first);
use Sub::Quote qw(qsub quote_sub);
+use Sub::Name ();
# Already correctly prototyped: perlbrew exec perl -MStorable -e 'warn prototype \&Storable::dclone'
BEGIN { *deep_clone = \&Storable::dclone }
our @EXPORT_OK = qw(
sigwarn_silencer modver_gt_or_eq modver_gt_or_eq_and_lt
fail_on_internal_wantarray fail_on_internal_call
- refdesc refcount hrefaddr
+ refdesc refcount hrefaddr set_subname
scope_guard detected_reinvoked_destructor
is_exception dbic_internal_try
quote_sub qsub perlstring serialize deep_clone dump_value
B::svref_2object($_[0])->REFCNT;
}
+# FIXME In another life switch this to a polyfill like the one in namespace::clean
+sub set_subname ($$) {
+
+ # fully qualify name
+ splice @_, 0, 1, caller(0) . "::$_[0]"
+ if $_[0] !~ /::|'/;
+
+ &Sub::Name::subname;
+}
+
sub serialize ($) {
local $Storable::canonical = 1;
nfreeze($_[0]);
my $destruction_registry = {};
sub CLONE {
- $destruction_registry = { map
- { defined $_ ? ( refaddr($_) => $_ ) : () }
- values %$destruction_registry
- };
+ %$destruction_registry = map {
+ (defined $_)
+ ? ( refaddr($_) => $_ )
+ : ()
+ } values %$destruction_registry;
+
+ weaken($_) for values %$destruction_registry;
# Dummy NEXTSTATE ensuring the all temporaries on the stack are garbage
# collected before leaving this scope. Depending on the code above, this
), 'with_stacktrace');
}
- my $mark = [];
- weaken ( $list_ctx_ok_stack_marker = $mark );
+ weaken( $list_ctx_ok_stack_marker = my $mark = [] );
+
$mark;
}
}
$fr = [ CORE::caller(1) ];
$argdesc = ref $DB::args[0]
? DBIx::Class::_Util::refdesc($DB::args[0])
- : undef
+ : ( $DB::args[0] . '' )
;
};
$fr->[1] !~ /\b(?:CDBICompat|ResultSetProxy)\b/ # no point touching there
) {
DBIx::Class::Exception->throw( sprintf (
- "Illegal internal call of indirect proxy-method %s() with argument %s: examine the last lines of the proxy method deparse below to determine what to call directly instead at %s on line %d\n\n%s\n\n Stacktrace starts",
+ "Illegal internal call of indirect proxy-method %s() with argument '%s': examine the last lines of the proxy method deparse below to determine what to call directly instead at %s on line %d\n\n%s\n\n Stacktrace starts",
$fr->[3], $argdesc, @{$fr}[1,2], ( $fr->[6] || do {
require B::Deparse;
no strict 'refs';