Peek.pm

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