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