use base 'Exporter';
our @EXPORT_OK = qw(
sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray
- refcount hrefaddr is_exception
+ refdesc refcount hrefaddr is_exception
is_plain_value is_literal_value
UNRESOLVABLE_CONDITION
);
return sub { &$orig_sig_warn unless $_[0] =~ $pattern };
}
-sub hrefaddr ($) { sprintf '0x%x', &Scalar::Util::refaddr }
+sub hrefaddr ($) { sprintf '0x%x', &Scalar::Util::refaddr||0 }
+
+sub refdesc ($) {
+ croak "Expecting a reference" if ! length ref $_[0];
+
+ # be careful not to trigger stringification,
+ # reuse @_ as a scratch-pad
+ sprintf '%s%s(0x%x)',
+ ( defined( $_[1] = blessed $_[0]) ? "$_[1]=" : '' ),
+ reftype $_[0],
+ Scalar::Util::refaddr($_[0]),
+ ;
+}
sub refcount ($) {
croak "Expecting a reference" if ! length ref $_[0];
if (defined $suberror) {
if (length (my $class = blessed($e) )) {
carp_unique( sprintf(
- 'External exception object %s=%s(%s) implements partial (broken) '
+ 'External exception object %s implements partial (broken) '
. 'overloading preventing it from being used in simple ($x eq $y) '
. 'comparisons. Given Perl\'s "globally cooperative" exception '
. 'handling this type of brokenness is extremely dangerous on '
. 'to the one shown at %s, in order to ensure your exception handling '
. 'is saner application-wide. What follows is the actual error text '
. "as generated by Perl itself:\n\n%s\n ",
- $class,
- reftype $e,
- hrefaddr $e,
+ refdesc $e,
$class,
'http://v.gd/DBIC_overload_tempfix/',
$suberror,
if (
(caller($cf))[0] =~ /^(?:DBIx::Class|DBICx::)/
) {
- my $obj = shift;
-
DBIx::Class::Exception->throw( sprintf (
- "Improper use of %s(%s) instance in list context at %s line %d\n\n\tStacktrace starts",
- ref($obj), hrefaddr($obj), (caller($cf))[1,2]
+ "Improper use of %s instance in list context at %s line %d\n\n\tStacktrace starts",
+ refdesc($_[0]), (caller($cf))[1,2]
), 'with_stacktrace');
}