From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Sun, 17 Mar 2002 23:06:12 +0000 (+0100)
Subject: B::perlstring()
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=51a5edaf68768c8b4cab40ee6760883cd469b0cb;p=p5sagit%2Fp5-mst-13.2.git

B::perlstring()
Message-ID: <20020317230612.A24442@rafael>

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

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 46c834a..305c5b8 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -7,7 +7,7 @@
 #
 package B;
 
-our $VERSION = '1.00';
+our $VERSION = '1.01';
 
 use XSLoader ();
 require Exporter;
@@ -18,7 +18,7 @@ require Exporter;
 @EXPORT_OK = qw(minus_c ppname save_BEGINs
 		class peekop cast_I32 cstring cchar hash threadsv_names
 		main_root main_start main_cv svref_2object opnumber
-		amagic_generation
+		amagic_generation perlstring
 		walkoptree_slow walkoptree walkoptree_exec walksymtable
 		parents comppadlist sv_undef compile_stats timing_info
 		begin_av init_av end_av regex_padav);
@@ -941,6 +941,11 @@ is only useful in a BEGIN block or else the flag is set too late.
 Returns a double-quote-surrounded escaped version of STR which can
 be used as a string in C source code.
 
+=item perlstring(STR)
+
+Returns a double-quote-surrounded escaped version of STR which can
+be used as a string in Perl source code.
+
 =item class(OBJ)
 
 Returns the class of an object without the part of the classname
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index c405ef3..39b38d1 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -8,7 +8,7 @@
 
 package B::Deparse;
 use Carp;
-use B qw(class main_root main_start main_cv svref_2object opnumber cstring
+use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
 	 OPf_WANT OPf_WANT_VOID OPf_WANT_SCALAR OPf_WANT_LIST
 	 OPf_KIDS OPf_REF OPf_STACKED OPf_SPECIAL OPf_MOD
 	 OPpLVAL_INTRO OPpOUR_INTRO OPpENTERSUB_AMPER OPpSLICE OPpCONST_BARE
@@ -542,14 +542,14 @@ sub compile {
 	my $self = B::Deparse->new(@args);
 	# First deparse command-line args
 	if (defined $^I) { # deparse -i
-	    print q(BEGIN { $^I = ).cstring($^I).qq(; }\n);
+	    print q(BEGIN { $^I = ).perlstring($^I).qq(; }\n);
 	}
 	if ($^W) { # deparse -w
 	    print qq(BEGIN { \$^W = $^W; }\n);
 	}
 	if ($/ ne "\n" or defined $O::savebackslash) { # deparse -l and -0
-	    my $fs = cstring($/) || 'undef';
-	    my $bs = cstring($O::savebackslash) || 'undef';
+	    my $fs = perlstring($/) || 'undef';
+	    my $bs = perlstring($O::savebackslash) || 'undef';
 	    print qq(BEGIN { \$/ = $fs; \$\\ = $bs; }\n);
 	}
 	my @BEGINs  = B::begin_av->isa("B::AV") ? B::begin_av->ARRAY : ();
@@ -1265,9 +1265,7 @@ sub declare_warnings {
     elsif (($to & WARN_MASK) eq "\0"x length($to)) {
 	return "no warnings;\n";
     }
-    my $wb = cstring($to);
-    $wb =~ s/([\$@])/\\$1/g;
-    return "BEGIN {\${^WARNING_BITS} = $wb}\n";
+    return "BEGIN {\${^WARNING_BITS} = ".perlstring($to)."}\n";
 }
 
 sub declare_hints {
diff --git a/ext/B/Makefile.PL b/ext/B/Makefile.PL
index 10e90b0..d39d3b5 100644
--- a/ext/B/Makefile.PL
+++ b/ext/B/Makefile.PL
@@ -15,14 +15,14 @@ if ($^O eq 'MSWin32') {
 }
 
 WriteMakefile(
-    NAME	=> "B",
-    VERSION	=> "1.00",
-    PL_FILES	=> { 'defsubs_h.PL' => 'defsubs.h' },
-    MAN3PODS	=> {},
-    clean	=> {
-	FILES		=> "perl$e *$o B.c defsubs.h *~"
+    NAME	    => "B",
+    VERSION_FROM    => "B.pm",
+    PL_FILES	    => { 'defsubs_h.PL' => 'defsubs.h' },
+    MAN3PODS	    => {},
+    clean	    => {
+	FILES	    => "perl$e *$o B.c defsubs.h *~"
     }
-);   
+);
 
 package MY;