[libtype-tiny-perl] 23/46: use Sub::Util as a fallback for Sub::Name

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to tag 1.001_000
in repository libtype-tiny-perl.

commit 16f78d900bc8c0a03d0f872f63f5de8ed76543b0
Author: Toby Inkster <mail at tobyinkster.co.uk>
Date:   Sun Aug 31 14:23:54 2014 +0100

    use Sub::Util as a fallback for Sub::Name
---
 lib/Type/Library.pm | 13 ++++++++-----
 lib/Type/Tiny.pm    | 18 ++++++++++++------
 2 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/lib/Type/Library.pm b/lib/Type/Library.pm
index 12aedbd..27a5ebd 100644
--- a/lib/Type/Library.pm
+++ b/lib/Type/Library.pm
@@ -22,14 +22,17 @@ BEGIN { *NICE_PROTOTYPES = ($] >= 5.014) ? sub () { !!1 } : sub () { !!0 } };
 sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
 
 {
-	my $got_subname;
+	my $subname;
 	my %already; # prevent renaming established functions
 	sub _subname ($$)
 	{
-		($got_subname or eval "require Sub::Name")
-			and ($got_subname = 1)
-			and !$already{refaddr($_[1])}++
-			and return(Sub::Name::subname(@_));
+		$subname =
+			eval { require Sub::Name } ? \&Sub::Name::subname :
+			eval { require Sub::Util } ? \&Sub::Util::set_subname :
+			0
+			if not defined $subname;
+		!$already{refaddr($_[1])}++ and return($subname->(@_))
+			if $subname;
 		return $_[1];
 	}
 }
diff --git a/lib/Type/Tiny.pm b/lib/Type/Tiny.pm
index 095e966..c55ba52 100644
--- a/lib/Type/Tiny.pm
+++ b/lib/Type/Tiny.pm
@@ -119,6 +119,7 @@ our %ALL_TYPES;
 
 my $QFS;
 my $uniq = 1;
+my $subname;
 sub new
 {
 	my $class  = shift;
@@ -203,14 +204,19 @@ sub new
 		$self->coercion->add_type_coercions(@$arr);
 	}
 	
-	if ($params{my_methods} and eval { require Sub::Name })
+	if ($params{my_methods})
 	{
-		for my $key (keys %{$params{my_methods}})
+		$subname =
+			eval { require Sub::Name } ? \&Sub::Name::subname :
+			eval { require Sub::Util } ? \&Sub::Util::set_subname :
+			0
+			if not defined $subname;
+		if ($subname)
 		{
-			Sub::Name::subname(
-				sprintf("%s::my_%s", $self->qualified_name, $key),
-				$params{my_methods}{$key},
-			);
+			$subname->(
+				sprintf("%s::my_%s", $self->qualified_name, $_),
+				$params{my_methods}{$_},
+			) for keys %{$params{my_methods}};
 		}
 	}
 	

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libtype-tiny-perl.git