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 (file)
--- 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 (file)
--- 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 (file)
--- 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;