Add safename() func to B

diff --git a/ext/B/B.pm b/ext/B/B.pm
index c908f51..7b4afdb 100644 (file)
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -35,7 +35,7 @@ push @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs
                        parents comppadlist sv_undef compile_stats timing_info
                        begin_av init_av check_av end_av regex_padav dowarn
                        defstash curstash warnhook diehook inc_gv @optype
-                       @specialsv_name unitcheck_av));
+                       @specialsv_name unitcheck_av safename));
 
 @B::SV::ISA = 'B::OBJECT';
 @B::NULL::ISA = 'B::SV';
@@ -85,7 +85,11 @@ push @B::EXPORT_OK, (qw(minus_c ppname save_BEGINs
 }
 
 sub B::GV::SAFENAME {
-  my $name = (shift())->NAME;
+  safename(shift()->NAME);
+}
+
+sub safename {
+  my $name = shift;
 
   # The regex below corresponds to the isCONTROLVAR macro
   # from toke.c
@@ -537,6 +541,13 @@ be used as a string in C source code.
 Returns a double-quote-surrounded escaped version of STR which can
 be used as a string in Perl source code.
 
+=item safename(STR)
+
+This function returns the string with the first character modified if it
+is a control character.  It converts it to ^X format first, so that "\cG"
+becomes "^G".  This is used internally by L<B::GV::SAFENAME|/SAFENAME>, but
+you can call it directly.
+
 =item class(OBJ)
 
 Returns the class of an object without the part of the classname

diff --git a/ext/B/t/b.t b/ext/B/t/b.t
index 8ee6510..9933978 100644 (file)
--- a/ext/B/t/b.t
+++ b/ext/B/t/b.t
@@ -300,6 +300,8 @@ foo
     can_ok $f, 'LINES';
 }
 
+is B::safename("\cLAST_FH"), "^LAST_FH", 'basic safename test';
+
 my $sub1 = sub {die};
 { no warnings 'once'; no strict; *Peel:: = *{"Pe\0e\x{142}::"} }
 my $sub2 = eval 'package Peel; sub {die}';