From: Nicholas Clark <nick@ccl4.org>
Date: Tue, 27 Dec 2005 23:39:42 +0000 (+0000)
Subject: s/%/%%/ in the package name so that it can be used safely in the
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fa6eee5ae7df0ed232a4efff3a72fda8726cb1b2;p=p5sagit%2Fp5-mst-13.2.git

s/%/%%/ in the package name so that it can be used safely in the
sprintf format string (and hence not need runtime %s interpolation)

p4raw-id: //depot/perl@26507
---

diff --git a/lib/ExtUtils/Constant.pm b/lib/ExtUtils/Constant.pm
index 9e2c9d9..c449a9b 100644
--- a/lib/ExtUtils/Constant.pm
+++ b/lib/ExtUtils/Constant.pm
@@ -243,17 +243,23 @@ EOT
   $xs .= ', &sv' if $params->{SV};
   $xs .= ");\n";
 
+  # If anyone is insane enough to suggest a package name containing %
+  my $package_sprintf_safe = $package;
+  $package_sprintf_safe =~ s/%/%%/g;
+
   $xs .= << "EOT";
       /* Return 1 or 2 items. First is error message, or undef if no error.
            Second, if present, is found value */
         switch (type) {
         case PERL_constant_NOTFOUND:
-          sv = sv_2mortal(newSVpvf("%s is not a valid $package macro", s));
+          sv =
+	    sv_2mortal(newSVpvf("%s is not a valid $package_sprintf_safe macro", s));
           PUSHs(sv);
           break;
         case PERL_constant_NOTDEF:
           sv = sv_2mortal(newSVpvf(
-	    "Your vendor has not defined $package macro %s, used", s));
+	    "Your vendor has not defined $package_sprintf_safe macro %s, used",
+				   s));
           PUSHs(sv);
           break;
 EOT
@@ -283,7 +289,7 @@ EOT
   $xs .= << "EOT";
         default:
           sv = sv_2mortal(newSVpvf(
-	    "Unexpected return type %d while processing $package macro %s, used",
+	    "Unexpected return type %d while processing $package_sprintf_safe macro %s, used",
                type, s));
           PUSHs(sv);
         }
diff --git a/lib/ExtUtils/Constant/ProxySubs.pm b/lib/ExtUtils/Constant/ProxySubs.pm
index bc0d200..57beb54 100644
--- a/lib/ExtUtils/Constant/ProxySubs.pm
+++ b/lib/ExtUtils/Constant/ProxySubs.pm
@@ -173,7 +173,9 @@ sub WriteConstants {
 
     $xs_subname ||= 'constant';
 
-    croak("Package name '$package' contains % characters") if $package =~ /%/;
+    # If anyone is insane enough to suggest a package name containing %
+    my $package_sprintf_safe = $package;
+    $package_sprintf_safe =~ s/%/%%/g;
 
     # All the types we see
     my $what = {};
@@ -199,7 +201,8 @@ sub WriteConstants {
 void ${c_subname}_add_symbol($pthx HV *hash, const char *name, I32 namelen, SV *value) {
     SV **sv = hv_fetch(hash, name, namelen, TRUE);
     if (!sv) {
-        Perl_croak($athx "Couldn't add key '%s' to %%%s::", name, "$package");
+        Perl_croak($athx "Couldn't add key '%s' to %%$package_sprintf_safe\::",
+		   name);
     }
     if (SvOK(*sv) || SvTYPE(*sv) == SVt_PVGV) {
 	/* Someone has been here before us - have to make a real sub.  */
@@ -220,8 +223,9 @@ static int
 Im_sorry_Dave(pTHX_ SV *sv, MAGIC *mg)
 {
     PERL_UNUSED_ARG(mg);
-    Perl_croak(aTHX_ "Your vendor has not defined $package macro %"SVf" used",
-	       sv);
+    Perl_croak(aTHX_
+	       "Your vendor has not defined $package_sprintf_safe macro %"SVf
+	       " used", sv);
     NORETURN_FUNCTION_END;
 }
 
@@ -344,8 +348,9 @@ EXPLODE
 	    SV **sv = hv_fetch(symbol_table, value_for_notfound->name,
 			       value_for_notfound->namelen, TRUE);
 	    if (!sv) {
-		Perl_croak($athx "Couldn't add key '%s' to %%%s::",
-			   value_for_notfound->name, "$package");
+		Perl_croak($athx
+			   "Couldn't add key '%s' to %%$package_sprintf_safe\::",
+			   value_for_notfound->name);
 	    }
 	    if (!SvOK(*sv) && SvTYPE(*sv) != SVt_PVGV) {
 		/* Nothing was here before, so mark a prototype of ""  */
@@ -435,7 +440,7 @@ $xs_subname(sv)
     INPUT:
 	SV *		sv;
     PPCODE:
-	sv = newSVpvf("Your vendor has not defined $package macro %" SVf
+	sv = newSVpvf("Your vendor has not defined $package_sprintf_safe macro %" SVf
 			  ", used", sv);
         PUSHs(sv_2mortal(sv));
 EXPLODE
@@ -449,10 +454,11 @@ $xs_subname(sv)
         const char *	s = SvPV(sv, len);
     PPCODE:
 	if (hv_exists(${c_subname}_missing, s, SvUTF8(sv) ? -len : len)) {
-	    sv = newSVpvf("Your vendor has not defined $package macro %" SVf
+	    sv = newSVpvf("Your vendor has not defined $package_sprintf_safe macro %" SVf
 			  ", used", sv);
 	} else {
-	    sv = newSVpvf("%" SVf " is not a valid $package macro", sv);
+	    sv = newSVpvf("%"SVf" is not a valid $package_sprintf_safe macro",
+			  sv);
 	}
         PUSHs(sv_2mortal(sv));
 DONT