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