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