From 002b978b598c42691928a27566ef8edaaeaa8696 Mon Sep 17 00:00:00 2001
From: Robin Houston <robin@cpan.org>
Date: Thu, 5 Apr 2001 15:27:38 +0100
Subject: print control-character vars readably Message-ID:
 <20010405142738.A15855@puffinry.freeserve.co.uk>

Needs EBCDICification.

p4raw-id: //depot/perl@9564
---
 ext/B/B.pm         | 21 +++++++++++++++++++++
 ext/B/B/Concise.pm |  4 ++--
 ext/B/B/Debug.pm   |  4 ++--
 ext/B/B/Terse.pm   |  2 +-
 4 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/ext/B/B.pm b/ext/B/B.pm
index ad8699f803..6c2f013da6 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -60,6 +60,12 @@ use strict;
     package B::OBJECT;
 }
 
+sub B::GV::SAFENAME {
+  my $name = (shift())->NAME;
+  $name =~ s/^([\cA-\cZ])/"^".chr(64 + ord($1))/e;
+  return $name;
+}
+
 my $debug;
 my $op_count = 0;
 my @parents = ();
@@ -449,6 +455,21 @@ This method returns TRUE if the GP field of the GV is NULL.
 
 =item NAME
 
+=item SAFENAME
+
+This method returns the name of the glob, but if the first
+character of the name is a control character, then it converts
+it to ^X first, so that *^G would return "^G" rather than "\cG".
+
+It's useful if you want to print out the name of a variable.
+If you restrict yourself to globs which exist at compile-time
+then the result ought to be unambiguous, because code like
+C<${"^G"} = 1> is compiled as two ops - a constant string and
+a dereference (rv2gv) - so that the glob is created at runtime.
+
+If you're working with globs at runtime, and need to disambiguate
+*^G from *{"^G"}, then you should use the raw NAME method.
+
 =item STASH
 
 =item SV
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 2dd43a932a..cb352ebf1c 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -385,8 +385,8 @@ sub concise_op {
 	    } else {
 		$stash = $stash . "::";
 	    }
-	    $h{arg} = "(*$stash" . $gv->NAME . ")";
-	    $h{svval} = "*$stash" . $gv->NAME;
+	    $h{arg} = "(*$stash" . $gv->SAFENAME . ")";
+	    $h{svval} = "*$stash" . $gv->SAFENAME;
 	} else {
 	    while (class($sv) eq "RV") {
 		$h{svval} .= "\\";
diff --git a/ext/B/B/Debug.pm b/ext/B/B/Debug.pm
index 71540a1bc7..049195b423 100644
--- a/ext/B/B/Debug.pm
+++ b/ext/B/B/Debug.pm
@@ -218,14 +218,14 @@ EOT
 sub B::GV::debug {
     my ($gv) = @_;
     if ($done_gv{$$gv}++) {
-	printf "GV %s::%s\n", $gv->STASH->NAME, $gv->NAME;
+	printf "GV %s::%s\n", $gv->STASH->NAME, $gv->SAFENAME;
 	return;
     }
     my ($sv) = $gv->SV;
     my ($av) = $gv->AV;
     my ($cv) = $gv->CV;
     $gv->B::SV::debug;
-    printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILE, $gv->GvFLAGS;
+    printf <<'EOT', $gv->SAFENAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILE, $gv->GvFLAGS;
 	NAME		%s
 	STASH		%s (0x%x)
 	SV		0x%x
diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm
index 8f669b463f..bf4ef4b386 100644
--- a/ext/B/B/Terse.pm
+++ b/ext/B/B/Terse.pm
@@ -102,7 +102,7 @@ sub B::GV::terse {
 	$stash = $stash . "::";
     }
     print indent($level);
-    printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->NAME;
+    printf "%s (0x%lx) *%s%s\n", class($gv), $$gv, $stash, $gv->SAFENAME;
 }
 
 sub B::IV::terse {
-- 
cgit v1.2.1