From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 23 Jan 2014 10:03:10 +0000 (+0100)
Subject: Move hrefaddr to DBIC::_Util, give most functions a prototype
X-Git-Tag: v0.08260~20
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf302897b5be1fe2e857b6be427dd66e82587547;p=dbsrgits%2FDBIx-Class.git

Move hrefaddr to DBIC::_Util, give most functions a prototype

This way we can safely do e.g. ( hrefaddr $foo, $unrelated_bar )
---

diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index 6b8f87c..60e0409 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -54,12 +54,12 @@ BEGIN {
 use DBIx::Class::Carp '^DBIx::Class|^DBICTest';
 
 use Carp 'croak';
-use Scalar::Util qw(refaddr weaken blessed reftype);
+use Scalar::Util qw(weaken blessed reftype);
 
 use base 'Exporter';
-our @EXPORT_OK = qw(sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray refcount is_exception);
+our @EXPORT_OK = qw(sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray refcount hrefaddr is_exception);
 
-sub sigwarn_silencer {
+sub sigwarn_silencer ($) {
   my $pattern = shift;
 
   croak "Expecting a regexp" if ref $pattern ne 'Regexp';
@@ -69,7 +69,9 @@ sub sigwarn_silencer {
   return sub { &$orig_sig_warn unless $_[0] =~ $pattern };
 }
 
-sub refcount {
+sub hrefaddr ($) { sprintf '0x%x', &Scalar::Util::refaddr }
+
+sub refcount ($) {
   croak "Expecting a reference" if ! length ref $_[0];
 
   require B;
@@ -93,7 +95,7 @@ sub is_exception ($) {
   if (defined $suberror) {
     if (length (my $class = blessed($e) )) {
       carp_unique( sprintf(
-        'External exception object %s=%s(0x%x) implements partial (broken) '
+        'External exception object %s=%s(%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 '
@@ -107,7 +109,7 @@ sub is_exception ($) {
       . "as generated by Perl itself:\n\n%s\n ",
         $class,
         reftype $e,
-        refaddr $e,
+        hrefaddr $e,
         $class,
         'http://v.gd/DBIC_overload_tempfix/',
         $suberror,
@@ -126,7 +128,7 @@ sub is_exception ($) {
   return $not_blank;
 }
 
-sub modver_gt_or_eq {
+sub modver_gt_or_eq ($$) {
   my ($mod, $ver) = @_;
 
   croak "Nonsensical module name supplied"
@@ -174,8 +176,8 @@ sub modver_gt_or_eq {
       my $obj = shift;
 
       DBIx::Class::Exception->throw( sprintf (
-        "Improper use of %s(0x%x) instance in list context at %s line %d\n\n\tStacktrace starts",
-        ref($obj), refaddr($obj), (caller($cf))[1,2]
+        "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]
       ), 'with_stacktrace');
     }
 
diff --git a/t/52leaks.t b/t/52leaks.t
index aefe40c..e5d498a 100644
--- a/t/52leaks.t
+++ b/t/52leaks.t
@@ -47,10 +47,10 @@ if ($ENV{DBICTEST_IN_PERSISTENT_ENV}) {
 
 use lib qw(t/lib);
 use DBICTest::RunMode;
-use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs hrefaddr);
+use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs);
 use Scalar::Util qw(weaken blessed reftype);
 use DBIx::Class;
-use DBIx::Class::_Util 'sigwarn_silencer';
+use DBIx::Class::_Util qw(hrefaddr sigwarn_silencer);
 BEGIN {
   plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test"
     if DBIx::Class::_ENV_::PEEPEENESS;
diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm
index 718a0aa..b3984b6 100644
--- a/t/lib/DBICTest/Util/LeakTracer.pm
+++ b/t/lib/DBICTest/Util/LeakTracer.pm
@@ -5,7 +5,7 @@ use strict;
 
 use Carp;
 use Scalar::Util qw(isweak weaken blessed reftype);
-use DBIx::Class::_Util 'refcount';
+use DBIx::Class::_Util qw(refcount hrefaddr);
 use DBIx::Class::Optional::Dependencies;
 use Data::Dumper::Concise;
 use DBICTest::Util 'stacktrace';
@@ -15,14 +15,12 @@ use constant {
 };
 
 use base 'Exporter';
-our @EXPORT_OK = qw(populate_weakregistry assert_empty_weakregistry hrefaddr visit_refs);
+our @EXPORT_OK = qw(populate_weakregistry assert_empty_weakregistry visit_refs);
 
 my $refs_traced = 0;
 my $leaks_found = 0;
 my %reg_of_regs;
 
-sub hrefaddr { sprintf '0x%x', &Scalar::Util::refaddr }
-
 # so we don't trigger stringification
 sub _describe_ref {
   sprintf '%s%s(%s)',