DBICTEST => eval { DBICTest::RunMode->is_author } ? 1 : 0,
# During 5.13 dev cycle HELEMs started to leak on copy
- PEEPEENESS =>
- # request for all tests would force "non-leaky" illusion and vice-versa
- defined $ENV{DBICTEST_ALL_LEAKS} ? !$ENV{DBICTEST_ALL_LEAKS}
- # otherwise confess that this perl is busted ONLY on smokers
- : eval { DBICTest::RunMode->is_smoker } && ($] >= 5.013005 and $] <= 5.013006) ? 1
- # otherwise we are good
- : 0
- ,
+ # add an escape for these perls ON SMOKERS - a user will still get death
+ PEEPEENESS => ( eval { DBICTest::RunMode->is_smoker } && ($] >= 5.013005 and $] <= 5.013006) ),
+
+ SHUFFLE_UNORDERED_RESULTSETS => $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS} ? 1 : 0,
ASSERT_NO_INTERNAL_WANTARRAY => $ENV{DBIC_ASSERT_NO_INTERNAL_WANTARRAY} ? 1 : 0,
use Carp 'croak';
use Scalar::Util qw(weaken blessed reftype);
+use List::Util qw(first);
+use overload ();
use base 'Exporter';
-our @EXPORT_OK = qw(sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray refcount hrefaddr is_exception);
+our @EXPORT_OK = qw(
+ sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray
+ refcount hrefaddr is_exception
+ is_plain_value is_literal_value
+);
sub sigwarn_silencer ($) {
my $pattern = shift;
local $SIG{__WARN__} = sigwarn_silencer( qr/\Qisn't numeric in subroutine entry/ )
if SPURIOUS_VERSION_CHECK_WARNINGS;
+ croak "$mod does not seem to provide a version (perhaps it never loaded)"
+ unless $mod->VERSION;
+
local $@;
eval { $mod->VERSION($ver) } ? 1 : 0;
}
+sub is_literal_value ($) {
+ (
+ ref $_[0] eq 'SCALAR'
+ or
+ ( ref $_[0] eq 'REF' and ref ${$_[0]} eq 'ARRAY' )
+ ) ? 1 : 0;
+}
+
+# FIXME XSify - this can be done so much more efficiently
+sub is_plain_value ($) {
+ no strict 'refs';
+ (
+ # plain scalar
+ (! length ref $_[0])
+ or
+ (
+ blessed $_[0]
+ and
+ # deliberately not using Devel::OverloadInfo - the checks we are
+ # intersted in are much more limited than the fullblown thing, and
+ # this is a relatively hot piece of code
+ (
+ # either has stringification which DBI prefers out of the box
+ #first { *{$_ . '::(""'}{CODE} } @{ mro::get_linear_isa( ref $_[0] ) }
+ overload::Method($_[0], '""')
+ or
+ # has nummification and fallback is *not* disabled
+ (
+ $_[1] = first { *{"${_}::(0+"}{CODE} } @{ mro::get_linear_isa( ref $_[0] ) }
+ and
+ ( ! defined ${"$_[1]::()"} or ${"$_[1]::()"} )
+ )
+ )
+ )
+ ) ? 1 : 0;
+}
+
{
my $list_ctx_ok_stack_marker;