DDumper.pm

   1 package DDumper;
   2
   3 use strict;
   4 use warnings;
   5
   6 use DynaLoader ();
   7
   8 use vars qw( $VERSION @ISA @EXPORT );
   9 $VERSION = "0.10";
  10 @ISA     = qw( DynaLoader Exporter );
  11 @EXPORT  = qw( DDumper DPeek DDump );
  12 $] >= 5.007003 and push @EXPORT, "DDump_IO";
  13
  14 bootstrap DDumper $VERSION;
  15
  16 use Data::Dumper;
  17
  18 sub DDumper
  19 {
  20     local $Data::Dumper::Sortkeys = 1;
  21     local $Data::Dumper::Indent   = 1;
  22
  23     my $s = Data::Dumper::Dumper @_;
  24     $s =~ s!^(\s*)'([^']*)'\s*=>!sprintf "%s%-16s =>", $1, $2!gme;      # Align => '
  25     $s =~ s!^(?= *[]}](?:[;,]|$))!  !gm;
  26     $s =~ s!^(\s+)!$1$1!gm;
  27     return $s;
  28     } # DDumper
  29
  30 sub _DDump_ref
  31 {
  32     my ($var, $down) = (@_, 0);
  33
  34     my $ref = ref $var;
  35     if ($ref eq "SCALAR" || $ref eq "REF") {
  36         my %hash = DDump ($$var, $down);
  37         return { %hash };
  38         }
  39     if ($ref eq "ARRAY") {
  40         my @list;
  41         foreach my $list (@$var) {
  42             my %hash = DDump ($list, $down);
  43             push @list, { %hash };
  44             }
  45         return [ @list ];
  46         }
  47     if ($ref eq "HASH") {
  48         my %hash;
  49         foreach my $key (sort keys %$var) {
  50             $hash{DPeek ($key)} = { DDump ($var->{$key}, $down) };
  51             }
  52         return { %hash };
  53         }
  54     $var;
  55     } # _DDump_ref
  56
  57 sub DDump ($;$)
  58 {
  59     my ($var, $down) = (@_, 0);
  60     my @dump = split "\n", DDump_XS ($var) or return;
  61
  62     if (wantarray) {
  63         my %hash;
  64         ($hash{sv} = $dump[0]) =~ s/^SV\s*=\s*//;
  65         m/^\s+(\w+)\s*=\s*(.*)/ and $hash{$1} = $2 for @dump;
  66
  67         if (exists $hash{FLAGS}) {
  68             $hash{FLAGS} =~ tr/()//d;
  69             $hash{FLAGS} = { map { $_ => 1 } split m/,/ => $hash{FLAGS} };
  70             }
  71
  72         $down && ref $var and
  73             $hash{RV} = _DDump_ref ($var, $down - 1);
  74         return %hash;
  75         }
  76
  77     my $dump = join "\n", @dump, "";
  78
  79     defined wantarray and return $dump;
  80
  81     print STDERR $dump;
  82     } # DDump
  83
  84 "Indent";
  85
  86 __END__
  87
  88 =head1 NAME
  89
  90 DDumper - Modified and extended debugging facilities
  91
  92 =head1 SYNOPSIS
  93
  94  use DDumper;
  95
  96  print DDumper \%hash;    # Same syntax as Data::Dumper
  97
  98  print DPeek \$var;
  99
 100  my $dump = DDump $var;
 101  my %hash = DDump \@list;
 102  DDump \%hash;
 103
 104  my %hash = DDump (\%hash, 5);  # dig 5 levels deep
 105
 106  my $dump;
 107  open my $fh, ">", \$dump;
 108  DDump_IO ($fh, \%hash, 6);
 109  close $fh;
 110  print $dump;
 111
 112 =head1 DESCRIPTION
 113
 114 =head2 DDumper ($var, ...)
 115
 116 Not liking the default output of Data::Dumper, and always feeling the need
 117 to set C<$Data::Dumper::Sortkeys = 1;>, and not liking any of the default
 118 layouts, this function is just a wrapper around Data::Dumper::Dumper with
 119 everything set as I like it.
 120
 121     $Data::Dumper::Sortkeys = 1;
 122     $Data::Dumper::Indent   = 1;
 123
 124 And the result is further beautified to meet my needs:
 125
 126   * quotation of hash keys has been removed
 127   * arrows for hashes are aligned at 20 (longer keys don't align)
 128   * closing braces and brackets are now correctly aligned
 129
 130 Example
 131
 132   print DDumper { ape => 1, foo => "egg", bar => [ 2, "baz", undef ]};
 133
 134   $VAR1 = {
 135       ape              => 1,
 136       bar              => [
 137           2,
 138           'baz',
 139           undef
 140           ],
 141       foo              => 'egg'
 142       };
 143
 144 =head2 DPeek ($var)
 145
 146 Playing with C<sv_dump ()>, I found C<Perl_sv_peek ()>, and it might be
 147 very useful for simple checks.
 148
 149 Example
 150
 151   print DPeek "abc\x{0a}de\x{20ac}fg";
 152
 153   PV("abc\nde\342\202\254fg"\0) [UTF8 "abc\nde\x{20ac}fg"]
 154
 155 =head3 DDump ($var [, $dig_level])
 156
 157 A very useful module when debugging is C<Devel::Peek>, but is has one big
 158 disadvantage: it only prints to STDERR, which is not very handy when your
 159 code wants to inspect variables al a low level.
 160
 161 Perl itself has C<sv_dump ()>, which does something similar, but still
 162 prints to STDERR, and only one level deep.
 163
 164 C<DDump ()> is an attempt to make the innards available to the script level
 165 with a reasonable level of compatibility. C<DDump ()> is context sensitive.
 166
 167 In void context, it behaves exactly like C<Perl_sv_dump ()>.
 168
 169 In scalar context, it returns what C<Perl_sv_dump ()> would have printed.
 170
 171 In list context, it returns a hash of the variable's properties. In this mode
 172 you can pass an optional second argument that detemines the depth of digging.
 173
 174 Example
 175
 176   print scalar DDump "abc\x{0a}de\x{20ac}fg"
 177
 178   SV = PV(0x723250) at 0x8432b0
 179     REFCNT = 1
 180     FLAGS = (PADBUSY,PADMY,POK,pPOK,UTF8)
 181     PV = 0x731ac0 "abc\nde\342\202\254fg"\0 [UTF8 "abc\nde\x{20ac}fg"]
 182     CUR = 11
 183     LEN = 16
 184
 185   my %h = DDump "abc\x{0a}de\x{20ac}fg";
 186   print DDumper \%h;
 187
 188   $VAR1 = {
 189       CUR              => '11',
 190       FLAGS            => {
 191           PADBUSY          => 1,
 192           PADMY            => 1,
 193           POK              => 1,
 194           UTF8             => 1,
 195           pPOK             => 1
 196           },
 197       LEN              => '16',
 198       PV               => '0x731ac0 "abc\\nde\\342\\202\\254fg"\\0 [UTF8 "abc\\nde\\x{20ac}fg"]',
 199       REFCNT           => '1',
 200       sv               => 'PV(0x723250) at 0x8432c0'
 201       };
 202
 203   my %h = DDump {
 204       ape => 1,
 205       foo => "egg",
 206       bar => [ 2, "baz", undef ],
 207       }, 1;
 208   print DDumper \%h;
 209
 210   $VAR1 = {
 211       FLAGS            => {
 212           PADBUSY          => 1,
 213           PADMY            => 1,
 214           ROK              => 1
 215           },
 216       REFCNT           => '1',
 217       RV               => {
 218           PVIV("ape")      => {
 219               FLAGS            => {
 220                   IOK              => 1,
 221                   PADBUSY          => 1,
 222                   PADMY            => 1,
 223                   pIOK             => 1
 224                   },
 225               IV               => '1',
 226               REFCNT           => '1',
 227               sv               => 'IV(0x747020) at 0x843a10'
 228               },
 229           PVIV("bar")      => {
 230               CUR              => '0',
 231               FLAGS            => {
 232                   PADBUSY          => 1,
 233                   PADMY            => 1,
 234                   ROK              => 1
 235                   },
 236               IV               => '1',
 237               LEN              => '0',
 238               PV               => '0x720210 ""',
 239               REFCNT           => '1',
 240               RV               => '0x720210',
 241               sv               => 'PVIV(0x7223e0) at 0x843a10'
 242               },
 243           PVIV("foo")      => {
 244               CUR              => '3',
 245               FLAGS            => {
 246                   PADBUSY          => 1,
 247                   PADMY            => 1,
 248                   POK              => 1,
 249                   pPOK             => 1
 250                   },
 251               IV               => '1',
 252               LEN              => '8',
 253               PV               => '0x7496c0 "egg"\\0',
 254               REFCNT           => '1',
 255               sv               => 'PVIV(0x7223e0) at 0x843a10'
 256               }
 257           },
 258       sv               => 'RV(0x79d058) at 0x843310'
 259       };
 260
 261 =head2 DDump_IO ($io, $var [, $dig_level])
 262
 263 A wrapper function around perl's internal C<Perl_do_sv_dump ()>, which
 264 makes C<Devel::Peek> completely superfluous. As PerlIO is only available
 265 perl version 5.7.3 and up, this function is not available in older perls.
 266
 267 Example
 268
 269   my $dump;
 270   open my $eh, ">", \$dump;
 271   DDump_IO ($eh, { 3 => 4, ape => [5..8]}, 6);
 272   close $eh;
 273   print $dump;
 274
 275   SV = RV(0x79d9e0) at 0x843f00
 276     REFCNT = 1
 277     FLAGS = (TEMP,ROK)
 278     RV = 0x741090
 279       SV = PVHV(0x79c948) at 0x741090
 280         REFCNT = 1
 281         FLAGS = (SHAREKEYS)
 282         IV = 2
 283         NV = 0
 284         ARRAY = 0x748ff0  (0:7, 2:1)
 285         hash quality = 62.5%
 286         KEYS = 2
 287         FILL = 1
 288         MAX = 7
 289         RITER = -1
 290         EITER = 0x0
 291           Elt "ape" HASH = 0x97623e03
 292           SV = RV(0x79d9d8) at 0x8440e0
 293             REFCNT = 1
 294             FLAGS = (ROK)
 295             RV = 0x741470
 296               SV = PVAV(0x7264b0) at 0x741470
 297                 REFCNT = 2
 298                 FLAGS = ()
 299                 IV = 0
 300                 NV = 0
 301                 ARRAY = 0x822f70
 302                 FILL = 3
 303                 MAX = 3
 304                 ARYLEN = 0x0
 305                 FLAGS = (REAL)
 306                   Elt No. 0
 307                   SV = IV(0x7467c8) at 0x7c1aa0
 308                     REFCNT = 1
 309                     FLAGS = (IOK,pIOK)
 310                     IV = 5
 311                   Elt No. 1
 312                   SV = IV(0x7467b0) at 0x8440f0
 313                     REFCNT = 1
 314                     FLAGS = (IOK,pIOK)
 315                     IV = 6
 316                   Elt No. 2
 317                   SV = IV(0x746810) at 0x75be00
 318                     REFCNT = 1
 319                     FLAGS = (IOK,pIOK)
 320                     IV = 7
 321                   Elt No. 3
 322                   SV = IV(0x746d38) at 0x7799d0
 323                     REFCNT = 1
 324                     FLAGS = (IOK,pIOK)
 325                     IV = 8
 326           Elt "3" HASH = 0xa400c7f3
 327           SV = IV(0x746fd0) at 0x7200e0
 328             REFCNT = 1
 329             FLAGS = (IOK,pIOK)
 330             IV = 4
 331
 332 =head1 INTERNALS
 333
 334 C<DDump ()> uses an XS wrapper around C<Perl_sv_dump ()> where the
 335 STDERR is temporarily caught to a pipe. The internal XS helper functions
 336 are not meant for user space
 337
 338 =head2 DDump_XS (SV *sv)
 339
 340 Base interface to internals for C<DDump ()>.
 341
 342 =head2 DDump_rf (SV *sv)
 343
 344 Dump the content of a reference variable like C<DDump_XS ()>.
 345
 346 =head1 BUGS
 347
 348 Not all types of references are supported.
 349
 350 It might crash.
 351
 352 No idea how far back this goes in perl support.
 353
 354 =head1 SEE ALSO
 355
 356 Devel::Peek
 357 Data::Dumper
 358 Data::Dump::Streamer
 359
 360 =head1 AUTHOR
 361
 362 H.Merijn Brand <h.m.brand@xs4all.nl>
 363
 364 =head1 COPYRIGHT AND LICENSE
 365
 366 Copyright (C) 2008-2008 H.Merijn Brand
 367
 368 This library is free software; you can redistribute it and/or modify
 369 it under the same terms as Perl itself.
 370
 371 =cut