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