@@ -54,12 +54,12 @@ BEGIN {
54
54
use DBIx::Class::Carp ' ^DBIx::Class|^DBICTest' ;
55
55
56
56
use Carp ' croak' ;
57
- use Scalar::Util qw( refaddr weaken blessed reftype) ;
57
+ use Scalar::Util qw( weaken blessed reftype) ;
58
58
59
59
use base ' Exporter' ;
60
- our @EXPORT_OK = qw( sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray refcount is_exception) ;
60
+ our @EXPORT_OK = qw( sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray refcount hrefaddr is_exception) ;
61
61
62
- sub sigwarn_silencer {
62
+ sub sigwarn_silencer ($) {
63
63
my $pattern = shift ;
64
64
65
65
croak " Expecting a regexp" if ref $pattern ne ' Regexp' ;
@@ -69,7 +69,9 @@ sub sigwarn_silencer {
69
69
return sub { &$orig_sig_warn unless $_ [0] =~ $pattern };
70
70
}
71
71
72
- sub refcount {
72
+ sub hrefaddr ($) { sprintf ' 0x%x' , &Scalar::Util::refaddr }
73
+
74
+ sub refcount ($) {
73
75
croak " Expecting a reference" if ! length ref $_ [0];
74
76
75
77
require B;
@@ -93,7 +95,7 @@ sub is_exception ($) {
93
95
if (defined $suberror ) {
94
96
if (length (my $class = blessed($e ) )) {
95
97
carp_unique( sprintf (
96
- ' External exception object %s=%s(0x%x ) implements partial (broken) '
98
+ ' External exception object %s=%s(%s ) implements partial (broken) '
97
99
. ' overloading preventing it from being used in simple ($x eq $y) '
98
100
. ' comparisons. Given Perl\' s "globally cooperative" exception '
99
101
. ' handling this type of brokenness is extremely dangerous on '
@@ -107,7 +109,7 @@ sub is_exception ($) {
107
109
. " as generated by Perl itself:\n\n %s \n " ,
108
110
$class ,
109
111
reftype $e ,
110
- refaddr $e ,
112
+ hrefaddr $e ,
111
113
$class ,
112
114
' http://v.gd/DBIC_overload_tempfix/' ,
113
115
$suberror ,
@@ -126,7 +128,7 @@ sub is_exception ($) {
126
128
return $not_blank ;
127
129
}
128
130
129
- sub modver_gt_or_eq {
131
+ sub modver_gt_or_eq ($$) {
130
132
my ($mod , $ver ) = @_ ;
131
133
132
134
croak " Nonsensical module name supplied"
@@ -174,8 +176,8 @@ sub modver_gt_or_eq {
174
176
my $obj = shift ;
175
177
176
178
DBIx::Class::Exception-> throw( sprintf (
177
- " Improper use of %s (0x %x ) instance in list context at %s line %d \n\n\t Stacktrace starts" ,
178
- ref ($obj ), refaddr ($obj ), (caller ($cf ))[1,2]
179
+ " Improper use of %s (%s ) instance in list context at %s line %d \n\n\t Stacktrace starts" ,
180
+ ref ($obj ), hrefaddr ($obj ), (caller ($cf ))[1,2]
179
181
), ' with_stacktrace' );
180
182
}
181
183
0 commit comments