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