From 859ad9e71e32c7a94a82ed0f03fedda390db3323 Mon Sep 17 00:00:00 2001
From: "H.Merijn Brand" <merijn@nb09.procura.nl>
Date: Thu, 23 Oct 2008 10:01:47 +0200
Subject: [PATCH] Implement DDisplay ()

---
 ChangeLog       |  4 ++++
 Peek.pm         | 21 +++++++++++++++++++--
 Peek.xs         | 14 ++++++++++++++
 t/21_DDisplay.t | 21 +++++++++++++++++++++
 4 files changed, 58 insertions(+), 2 deletions(-)
 create mode 100644 t/21_DDisplay.t

diff --git a/ChangeLog b/ChangeLog
index 1c3fef2..efb1625 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2008-10-23 0.24 - H.Merijn Brand   <h.m.brand@xs4all.nl>
+
+	* Implement DDisplay ()
+
 2008-10-21 0.23 - H.Merijn Brand   <h.m.brand@xs4all.nl>
 
 	* Selecting to install DP did not install Data::Peek
diff --git a/Peek.pm b/Peek.pm
index c213232..7cd873a 100644
--- a/Peek.pm
+++ b/Peek.pm
@@ -6,9 +6,9 @@ use warnings;
 use DynaLoader ();
 
 use vars qw( $VERSION @ISA @EXPORT );
-$VERSION = "0.23";
+$VERSION = "0.24";
 @ISA     = qw( DynaLoader Exporter );
-@EXPORT  = qw( DDumper DPeek DDump DDual );
+@EXPORT  = qw( DDumper DPeek DDisplay DDump DDual );
 $] >= 5.007003 and push @EXPORT, "DDump_IO";
 
 bootstrap Data::Peek $VERSION;
@@ -128,6 +128,7 @@ Data::Peek - A collection of low-level debug facilities
  print DPeek \$var;
  my ($pv, $iv, $nv, $rv, $magic) = DDual ($var [, 1]);
  print DPeek for DDual ($!, 1);
+ print DDisplay ("ab\nc\x{20ac}\rdef\n");
 
  my $dump = DDump $var;
  my %hash = DDump \@list;
@@ -194,6 +195,22 @@ Example
 
   PV("abc\nde\342\202\254fg"\0) [UTF8 "abc\nde\x{20ac}fg"]
 
+=head2 DDisplay
+
+=head2 DDisplay ($var)
+
+Show the PV content of a scalar the way perl debugging would have done.
+UTF-8 detection is on, so this is effectively the same as returning the
+first part the C<DPeek ()> returns for non-UTF8 PV's or the second part
+for UTF-8 PV's. C<DDisplay ()> returns the empty string for scalars that
+no have a valid PV.
+
+Example
+
+  print DDisplay "abc\x{0a}de\x{20ac}fg";
+
+  "abc\nde\x{20ac}fg"
+
 =head2 DDual ($var [, $getmagic])
 
 DDual will return the basic elements in a variable, guaranteeing that no
diff --git a/Peek.xs b/Peek.xs
index 832ca95..910aae7 100644
--- a/Peek.xs
+++ b/Peek.xs
@@ -69,6 +69,20 @@ DPeek (...)
 #endif
 
 void
+DDisplay (...)
+  PROTOTYPE: ;$
+  PPCODE:
+    SV *sv  = items ? ST (0) : DEFSV;
+    SV *dsp = newSVpv ("", 0);
+    if (SvPOK (sv) || SvPOKp (sv))
+	Perl_pv_pretty (aTHX_ dsp, SvPVX (sv), SvCUR (sv), NULL,
+	    NULL, NULL,
+	    (PERL_PV_PRETTY_DUMP | PERL_PV_ESCAPE_UNI_DETECT));
+    ST (0) = dsp;
+    XSRETURN (1);
+    /* XS DDisplay */
+
+void
 DDual (sv, ...)
     SV   *sv
 
diff --git a/t/21_DDisplay.t b/t/21_DDisplay.t
new file mode 100644
index 0000000..3077604
--- /dev/null
+++ b/t/21_DDisplay.t
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+
+use Data::Peek;
+
+is (DDisplay (undef),		'',		'undef  has no PV');
+is (DDisplay (0),		'',		'0      has no PV');
+is (DDisplay (\undef),		'',		'\undef has no PV');
+is (DDisplay (\0),		'',		'\0     has no PV');
+is (DDisplay (sub {}),		'',		'code   has no PV');
+
+is (DDisplay (""),		'""',		'empty string');
+is (DDisplay ("a"),		'"a"',		'"a"');
+is (DDisplay ("\n"),		'"\n"',		'"\n"');
+is (DDisplay ("\x{20ac}"),	'"\x{20ac}"',	'"\n"');
+
+1;
-- 
2.11.4.GIT