From 5f6869b14e81358999aba242abe892975aee55f5 Mon Sep 17 00:00:00 2001
From: "H.Merijn Brand" <merijn@tux09.procura.nl>
Date: Sat, 28 Aug 2010 16:04:46 +0200
Subject: [PATCH] add DHexDump

---
 ChangeLog |  3 ++-
 Peek.pm   | 46 +++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 47 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 734be02..1197acd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,8 @@
-2010-06-10 0.32 - H.Merijn Brand   <h.m.brand@xs4all.nl>
+2010-08-28 0.32 - H.Merijn Brand   <h.m.brand@xs4all.nl>
 
     * DGrow tests for bigger gap
     * Spell checking
+    * Add DHexDump ()
 
 2010-03-16 0.31 - H.Merijn Brand   <h.m.brand@xs4all.nl>
 
diff --git a/Peek.pm b/Peek.pm
index 5811d62..f78a80c 100644
--- a/Peek.pm
+++ b/Peek.pm
@@ -8,7 +8,7 @@ use DynaLoader ();
 use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
 $VERSION   = "0.32";
 @ISA       = qw( DynaLoader Exporter );
-@EXPORT    = qw( DDumper DDsort DPeek DDisplay DDump DDual DGrow );
+@EXPORT    = qw( DDumper DDsort DPeek DDisplay DDump DHexDump DDual DGrow );
 @EXPORT_OK = qw( triplevar );
 $] >= 5.007003 and push @EXPORT, "DDump_IO";
 
@@ -166,6 +166,32 @@ sub DDump ($;$)
     warn $dump;
     } # DDump
 
+sub DHexDump
+{
+    use bytes;
+    my $off = 0;
+    my @out = "";
+    my $var = @_ ? $_[0] : $_ or return;
+    my $str = "$var";	# force stringification
+    for (unpack "(A32)*", unpack "H*", $str) {
+	my @b = unpack "(A2)*", $_;
+	my $out = sprintf "%04x ", $off;
+	$out .= " ".($b[$_]||"  ") for 0 ..  7;
+	$out .= " ";
+	$out .= " ".($b[$_]||"  ") for 8 .. 15;
+	$out .= "  ";
+	$out .= ($_ < 0x20 || $_ >= 0x7f ? "." : chr $_) for map { hex $_ } @b;
+	push @out, $out."\n";
+	$off += 16;
+	}
+
+    wantarray and return @out;
+
+    defined wantarray and return join "", @out;
+
+    warn join "", @out;
+    } # DHexDump
+
 "Indent";
 
 __END__
@@ -184,6 +210,7 @@ Data::Peek - A collection of low-level debug facilities
  my ($pv, $iv, $nv, $rv, $magic) = DDual ($var [, 1]);
  print DPeek for DDual ($!, 1);
  print DDisplay ("ab\nc\x{20ac}\rdef\n");
+ print DHexDump ("ab\nc\x{20ac}\rdef\n");
 
  my $dump = DDump $var;
  my %hash = DDump \@list;
@@ -298,6 +325,23 @@ Example
 
   "abc\nde\x{20ac}fg"
 
+=head2 DHexDump
+
+=head2 DHexDump ($var)
+
+Show the PV content of a scalar as a hex-dump.
+If C<$var> is omitted, C<$_> is dumped. For empty strings and undef values
+there is no action.
+In void context, the dump is done to STDERR. In scalar context, the
+complete dump is returned as a single string. In list context, the dump
+is returned as lines.
+
+Example
+
+  print DHexDump "abc\x{0a}de\x{20ac}fg";
+
+  0000  61 62 63 0a 64 65 e2 82  ac 66 67                 abc.de...fg
+
 =head2 my ($pv, $iv, $nv, $rv, $hm) = DDual ($var [, $getmagic])
 
 DDual will return the basic elements in a variable, guaranteeing that no
-- 
2.11.4.GIT