Skip to content

Commit bf30289

Browse files
committed
Move hrefaddr to DBIC::_Util, give most functions a prototype
This way we can safely do e.g. ( hrefaddr $foo, $unrelated_bar )
1 parent 841efcb commit bf30289

File tree

3 files changed

+15
-15
lines changed

3 files changed

+15
-15
lines changed

lib/DBIx/Class/_Util.pm

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -54,12 +54,12 @@ BEGIN {
5454
use DBIx::Class::Carp '^DBIx::Class|^DBICTest';
5555

5656
use Carp 'croak';
57-
use Scalar::Util qw(refaddr weaken blessed reftype);
57+
use Scalar::Util qw(weaken blessed reftype);
5858

5959
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);
6161

62-
sub sigwarn_silencer {
62+
sub sigwarn_silencer ($) {
6363
my $pattern = shift;
6464

6565
croak "Expecting a regexp" if ref $pattern ne 'Regexp';
@@ -69,7 +69,9 @@ sub sigwarn_silencer {
6969
return sub { &$orig_sig_warn unless $_[0] =~ $pattern };
7070
}
7171

72-
sub refcount {
72+
sub hrefaddr ($) { sprintf '0x%x', &Scalar::Util::refaddr }
73+
74+
sub refcount ($) {
7375
croak "Expecting a reference" if ! length ref $_[0];
7476

7577
require B;
@@ -93,7 +95,7 @@ sub is_exception ($) {
9395
if (defined $suberror) {
9496
if (length (my $class = blessed($e) )) {
9597
carp_unique( sprintf(
96-
'External exception object %s=%s(0x%x) implements partial (broken) '
98+
'External exception object %s=%s(%s) implements partial (broken) '
9799
. 'overloading preventing it from being used in simple ($x eq $y) '
98100
. 'comparisons. Given Perl\'s "globally cooperative" exception '
99101
. 'handling this type of brokenness is extremely dangerous on '
@@ -107,7 +109,7 @@ sub is_exception ($) {
107109
. "as generated by Perl itself:\n\n%s\n ",
108110
$class,
109111
reftype $e,
110-
refaddr $e,
112+
hrefaddr $e,
111113
$class,
112114
'http://v.gd/DBIC_overload_tempfix/',
113115
$suberror,
@@ -126,7 +128,7 @@ sub is_exception ($) {
126128
return $not_blank;
127129
}
128130

129-
sub modver_gt_or_eq {
131+
sub modver_gt_or_eq ($$) {
130132
my ($mod, $ver) = @_;
131133

132134
croak "Nonsensical module name supplied"
@@ -174,8 +176,8 @@ sub modver_gt_or_eq {
174176
my $obj = shift;
175177

176178
DBIx::Class::Exception->throw( sprintf (
177-
"Improper use of %s(0x%x) instance in list context at %s line %d\n\n\tStacktrace 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\tStacktrace starts",
180+
ref($obj), hrefaddr($obj), (caller($cf))[1,2]
179181
), 'with_stacktrace');
180182
}
181183

t/52leaks.t

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -47,10 +47,10 @@ if ($ENV{DBICTEST_IN_PERSISTENT_ENV}) {
4747

4848
use lib qw(t/lib);
4949
use DBICTest::RunMode;
50-
use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs hrefaddr);
50+
use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs);
5151
use Scalar::Util qw(weaken blessed reftype);
5252
use DBIx::Class;
53-
use DBIx::Class::_Util 'sigwarn_silencer';
53+
use DBIx::Class::_Util qw(hrefaddr sigwarn_silencer);
5454
BEGIN {
5555
plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test"
5656
if DBIx::Class::_ENV_::PEEPEENESS;

t/lib/DBICTest/Util/LeakTracer.pm

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ use strict;
55

66
use Carp;
77
use Scalar::Util qw(isweak weaken blessed reftype);
8-
use DBIx::Class::_Util 'refcount';
8+
use DBIx::Class::_Util qw(refcount hrefaddr);
99
use DBIx::Class::Optional::Dependencies;
1010
use Data::Dumper::Concise;
1111
use DBICTest::Util 'stacktrace';
@@ -15,14 +15,12 @@ use constant {
1515
};
1616

1717
use base 'Exporter';
18-
our @EXPORT_OK = qw(populate_weakregistry assert_empty_weakregistry hrefaddr visit_refs);
18+
our @EXPORT_OK = qw(populate_weakregistry assert_empty_weakregistry visit_refs);
1919

2020
my $refs_traced = 0;
2121
my $leaks_found = 0;
2222
my %reg_of_regs;
2323

24-
sub hrefaddr { sprintf '0x%x', &Scalar::Util::refaddr }
25-
2624
# so we don't trigger stringification
2725
sub _describe_ref {
2826
sprintf '%s%s(%s)',

0 commit comments

Comments
 (0)