From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sun, 4 Jul 1999 20:03:21 +0000 (+0000)
Subject: make overload, Data::Dumper, and dumpvar understand qr// stringify
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7894fbab1e479c2ce906aed9132b15a68bfa5d73;p=p5sagit%2Fp5-mst-13.2.git

make overload, Data::Dumper, and dumpvar understand qr// stringify
overloading

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

diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm
index d653af3..3828d7b 100644
--- a/ext/Data/Dumper/Dumper.pm
+++ b/ext/Data/Dumper/Dumper.pm
@@ -259,14 +259,22 @@ sub _dump {
       }
     }
 
+    if ($realpack) {
+      if ($realpack eq 'Regexp') {
+	$out = "$val";
+	$out =~ s,/,\\/,g;
+	return "qr/$out/";
+      }
+      else {          # we have a blessed ref
+	$out = $s->{'bless'} . '( ';
+	$blesspad = $s->{apad};
+	$s->{apad} .= '       ' if ($s->{indent} >= 2);
+      }
+    }
+
     $s->{level}++;
     $ipad = $s->{xpad} x $s->{level};
 
-    if ($realpack) {          # we have a blessed ref
-      $out = $s->{'bless'} . '( ';
-      $blesspad = $s->{apad};
-      $s->{apad} .= '       ' if ($s->{indent} >= 2);
-    }
     
     if ($realtype eq 'SCALAR') {
       if ($realpack) {
diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index e0ca403..27d128b 100644
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -251,22 +251,40 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
 		SvREFCNT_dec(seenentry);
 	    }
 	}
-	
-	(*levelp)++;
-	ipad = sv_x(aTHX_ Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp);
 
-	if (realpack) {   /* we have a blessed ref */
-	    STRLEN blesslen;
-	    char *blessstr = SvPV(bless, blesslen);
-	    sv_catpvn(retval, blessstr, blesslen);
-	    sv_catpvn(retval, "( ", 2);
-	    if (indent >= 2) {
-		blesspad = apad;
-		apad = newSVsv(apad);
-		sv_x(aTHX_ apad, " ", 1, blesslen+2);
+	if (realpack) {
+	    if (*realpack == 'R' && strEQ(realpack, "Regexp")) {
+		STRLEN rlen;
+		char *rval = SvPV(val, rlen);
+		char *slash = strchr(rval, '/');
+		sv_catpvn(retval, "qr/", 3);
+		while (slash) {
+		    sv_catpvn(retval, rval, slash-rval);
+		    sv_catpvn(retval, "\\/", 2);
+		    rlen -= slash-rval+1;
+		    rval = slash+1;
+		    slash = strchr(rval, '/');
+		}
+		sv_catpvn(retval, rval, rlen);
+		sv_catpvn(retval, "/", 1);
+		return 1;
+	    }
+	    else {				/* we have a blessed ref */
+		STRLEN blesslen;
+		char *blessstr = SvPV(bless, blesslen);
+		sv_catpvn(retval, blessstr, blesslen);
+		sv_catpvn(retval, "( ", 2);
+		if (indent >= 2) {
+		    blesspad = apad;
+		    apad = newSVsv(apad);
+		    sv_x(aTHX_ apad, " ", 1, blesslen+2);
+		}
 	    }
 	}
 
+	(*levelp)++;
+	ipad = sv_x(aTHX_ Nullsv, SvPVX(xpad), SvCUR(xpad), *levelp);
+
 	if (realtype <= SVt_PVBM) {			     /* scalar ref */
 	    SV *namesv = newSVpvn("${", 2);
 	    sv_catpvn(namesv, name, namelen);
diff --git a/lib/Dumpvalue.pm b/lib/Dumpvalue.pm
index 5bcd58f..9c596ff 100644
--- a/lib/Dumpvalue.pm
+++ b/lib/Dumpvalue.pm
@@ -181,6 +181,13 @@ sub unwrap {
     }
   }
 
+  if (ref $v eq 'Regexp') {
+    my $re = "$v";
+    $re =~ s,/,\\/,g;
+    print "$sp-> qr/$re/\n";
+    return;
+  }
+
   if ( UNIVERSAL::isa($v, 'HASH') ) {
     my @sortKeys = sort keys(%$v) ;
     my $more;
diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index 32d4692..fb0bb23 100644
--- a/lib/dumpvar.pl
+++ b/lib/dumpvar.pl
@@ -143,6 +143,13 @@ sub unwrap {
       } 
     }
 
+    if (ref $v eq 'Regexp') {
+      my $re = "$v";
+      $re =~ s,/,\\/,g;
+      print "$sp-> qr/$re/\n";
+      return;
+    }
+
     if ( UNIVERSAL::isa($v, 'HASH') ) { 
 	@sortKeys = sort keys(%$v) ;
 	undef $more ; 
diff --git a/lib/overload.pm b/lib/overload.pm
index bcb56c3..c46be83 100644
--- a/lib/overload.pm
+++ b/lib/overload.pm
@@ -87,7 +87,7 @@ sub AddrRef {
 }
 
 sub StrVal {
-  (OverloadedStringify($_[0])) ?
+  (OverloadedStringify($_[0]) or ref($_[0]) eq 'Regexp') ?
     (AddrRef(shift)) :
     "$_[0]";
 }
diff --git a/pp_ctl.c b/pp_ctl.c
index 9b5c932..64e695b 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2817,7 +2817,7 @@ S_doopen_pmc(pTHX_ const char *name, const char *mode)
     STRLEN namelen = strlen(name);
     PerlIO *fp;
 
-    if (namelen > 3 && strcmp(name + namelen - 3, ".pm") == 0) {
+    if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) {
 	SV *pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c');
 	char *pmc = SvPV_nolen(pmcsv);
 	Stat_t pmstat;