namification
Matt S Trout [Sat, 12 May 2012 00:31:07 +0000 (00:31 +0000)]
Changes
lib/Package/Variant.pm

diff --git a/Changes b/Changes
index aab8f9c..a57045c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,2 +1,4 @@
+  - Use Sub::Name to name installed things if available
+
 1.000000 - 2012-01-23
   - initial release
index 55dd25c..87c0d74 100644 (file)
@@ -47,6 +47,10 @@ my $sanitize_importing = sub {
   return \@imports;
 };
 
+my $sub_namer = eval {
+  require Sub::Name; sub { shift if @_ > 2; Sub::Name::subname(@_) }
+} || sub { $_[-1] };
+
 sub import {
   my $target = caller;
   my $me = shift;
@@ -108,9 +112,12 @@ sub build_variant_of {
   my $subs = $Variable{$variable}{subs};
   local @{$subs}{keys %$subs} = map $variant_name->can($_), keys %$subs;
   local $Variable{$variable}{install} = sub {
-    my ($name, $ref) = @_;
+    my $full_name = "${variant_name}::".shift;
+
+    my $ref = $sub_namer->($full_name, @_);
+    
     no strict 'refs';
-    *{"${variant_name}::${name}"} = $ref;
+    *$full_name = $ref;
   };
   $variable->make_variant($variant_name, @args);
   return $variant_name;