Allow package name in ‘use constant’ constants

See the thread that includes
<20140821044934.29399.qmail@lists-nntp.develooper.com>.

This provides a way for a package to define constants in another pack-
age, without having to resort to *other::const = sub () { $value }.
Now one can write constant->import("other::const" => $value).

Documentation will be added in an upcoming commit.

2 files changed, 30 insertions, 7 deletions

diff --git a/dist/constant/lib/constant.pm b/dist/constant/lib/constant.pm
index 5d0d547ae3..91a1451fa6 100644
--- a/dist/constant/lib/constant.pm
+++ b/dist/constant/lib/constant.pm
@@ -56,13 +56,13 @@ sub import {
     return unless @_;			# Ignore 'use constant;'
     my $constants;
     my $multiple  = ref $_[0];
-    my $pkg = caller;
+    my $caller = caller;
     my $flush_mro;
     my $symtab;
 
     if (_CAN_PCS) {
 	no strict 'refs';
-	$symtab = \%{$pkg . '::'};
+	$symtab = \%{$caller . '::'};
     };
 
     if ( $multiple ) {
@@ -80,6 +80,20 @@ sub import {
     }
 
     foreach my $name ( keys %$constants ) {
+	my $pkg;
+	my $symtab = $symtab;
+	my $orig_name = $name;
+	if ($name =~ s/(.*)(?:::|')(?=.)//s) {
+	    $pkg = $1;
+	    if (_CAN_PCS && $pkg ne $caller) {
+		no strict 'refs';
+		$symtab = \%{$pkg . '::'};
+	    }
+	}
+	else {
+	    $pkg = $caller;
+	}
+
 	# Normal constant name
 	if ($name =~ $normal_constant_name and !$forbidden{$name}) {
 	    # Everything is okay
@@ -127,7 +141,7 @@ sub import {
 	    my $full_name = "${pkg}::$name";
 	    $declared{$full_name}++;
 	    if ($multiple || @_ == 1) {
-		my $scalar = $multiple ? $constants->{$name} : $_[0];
+		my $scalar = $multiple ? $constants->{$orig_name} : $_[0];
 
 		if (_DOWNGRADE) { # for 5.8 to 5.14
 		    # Work around perl bug #31991: Sub names (actually glob
@@ -149,7 +163,7 @@ sub import {
 		    Internals::SvREADONLY($scalar, 1);
 		    if ($symtab && !exists $symtab->{$name}) {
 			$symtab->{$name} = \$scalar;
-			++$flush_mro;
+			++$flush_mro->{$pkg};
 		    }
 		    else {
 			local $constant::{_dummy} = \$scalar;
@@ -165,7 +179,7 @@ sub import {
 		    _make_const(@list);
 		    if ($symtab && !exists $symtab->{$name}) {
 			$symtab->{$name} = \@list;
-			$flush_mro++;
+			$flush_mro->{$pkg}++;
 		    }
 		    else {
 			local $constant::{_dummy} = \@list;
@@ -179,7 +193,9 @@ sub import {
 	}
     }
     # Flush the cache exactly once if we make any direct symbol table changes.
-    mro::method_changed_in($pkg) if _CAN_PCS && $flush_mro;
+    if (_CAN_PCS && $flush_mro) {
+	mro::method_changed_in($_) for keys %$flush_mro;
+    }
 }
 
 1;
diff --git a/dist/constant/t/constant.t b/dist/constant/t/constant.t
index 159e2173de..00eddfb657 100644
--- a/dist/constant/t/constant.t
+++ b/dist/constant/t/constant.t
@@ -9,7 +9,7 @@ END { @warnings && print STDERR join "\n- ", "accumulated warnings:", @warnings
 
 
 use strict;
-use Test::More tests => 105;
+use Test::More tests => 109;
 my $TB = Test::More->builder;
 
 BEGIN { use_ok('constant'); }
@@ -414,3 +414,10 @@ SKIP: {
     is $values[1], $values[0],
 	'modifying list const elements does not affect future retavls';
 }
+
+use constant { "tahi" => 1, "rua::rua" => 2, "toru'toru" => 3 };
+use constant "wha::wha" => 4;
+is tahi, 1, 'unqualified constant declared with constants in other pkgs';
+is rua::rua, 2, 'constant declared with ::';
+is toru::toru, 3, "constant declared with '";
+is wha::wha, 4, 'constant declared by itself with ::';