Allow length for DHexDump ()
authorH.Merijn Brand <merijn@lx09.procura.nl>
Mon, 16 Apr 2012 16:18:13 +0000 (16 18:18 +0200)
committerH.Merijn Brand <merijn@lx09.procura.nl>
Mon, 16 Apr 2012 16:18:13 +0000 (16 18:18 +0200)
ChangeLog
Peek.pm
t/22_DHexDump.t

index 966dbac..0f16e45 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,6 @@
-0.37   2012-01-11, H.Merijn Brand   <h.m.brand@xs4all.nl>
+0.37   2012-04-16, H.Merijn Brand   <h.m.brand@xs4all.nl>
     * Upped copyright to 2012
+    * Allow length for DHexDump ()
 
 0.36   2011-09-07, H.Merijn Brand   <h.m.brand@xs4all.nl>
     * NAME / DISTNAME in Makefile.PL
diff --git a/Peek.pm b/Peek.pm
index 8f91693..b0a4543 100644 (file)
--- a/Peek.pm
+++ b/Peek.pm
@@ -204,6 +204,7 @@ sub DHexDump
     my $var = @_ ? $_[0] : $_;
     defined $var or return;
     my $str = "$var";  # force stringification
+    @_ > 1 && $_[1] < length $str and substr ($str, $_[1]) = "";
     for (unpack "(A32)*", unpack "H*", $str) {
        my @b = unpack "(A2)*", $_;
        my $out = sprintf "%04x ", $off;
@@ -389,9 +390,12 @@ Example
 
 =head2 DHexDump ($var)
 
+=head2 DHexDump ($var, $length)
+
 Show the (stringified) content of a scalar as a hex-dump.  If C<$var>
 is omitted, C<$_> is dumped. Returns C<undef> or an empty list if
-C<$var> (or C<$_>) is undefined.
+C<$var> (or C<$_>) is undefined. If C<$length> is given and is lower than
+the length of the stringified C<$var>, only <$length> bytes are dumped.
 
 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
index a37fe6f..0846908 100644 (file)
@@ -14,7 +14,12 @@ is (DHexDump (""),           "",                     '""');
 for (split m/##\n/ => test_data ()) {
     my ($desc, $in, $out) = split m/\n-\n/, $_, 3;
 
-    is (scalar DHexDump ($in), $out,   "HexDump $desc");
+    if ($in =~ s/\t(\d+)$//) {
+       is (scalar DHexDump ($in, $1), $out,    "HexDump $desc");
+       }
+    else {
+       is (scalar DHexDump ($in),     $out,    "HexDump $desc");
+       }
     }
 
 done_testing;
@@ -34,6 +39,12 @@ abc\x{0a}de\x{20ac}fg
 -
 0000  61 62 63 0a 64 65 e2 82  ac 66 67                 abc.de...fg
 ##
+Documentation example with length
+-
+abc\x{0a}de\x{20ac}fg  6
+-
+0000  61 62 63 0a 64 65                                 abc.de
+##
 Binary data
 -
 \x01Great wide open space\x02\x{20ac}\n