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 @EXPORT_OK );
   9 $VERSION   = "0.26";
  10 @ISA       = qw( DynaLoader Exporter );
  11 @EXPORT    = qw( DDumper DDsort DPeek DDisplay DDump DDual );
  12 @EXPORT_OK = qw( triplevar );
  13 $] >= 5.007003 and push @EXPORT, "DDump_IO";
  14
  15 bootstrap Data::Peek $VERSION;
  16
  17 ### ############# DDumper () ##################################################
  18
  19 use Data::Dumper;
  20
  21 my %sk = (
  22     undef       => 0,
  23     ""          => 0,
  24     0           => 0,
  25     1           => 1,
  26
  27     V   => sub {        # Sort by value
  28             my $r = shift;
  29             [         sort { $r->{$a} cmp $r->{$b} } keys %$r ];
  30             },
  31     VN  => sub {        # Sort by value numeric
  32             my $r = shift;
  33             [         sort { $r->{$a} <=> $r->{$b} } keys %$r ];
  34             },
  35     VNR => sub {        # Sort by value numeric reverse
  36             my $r = shift;
  37             [         sort { $r->{$b} <=> $r->{$a} } keys %$r ];
  38             },
  39     VR  => sub {        # Sort by value reverse
  40             my $r = shift;
  41             [         sort { $r->{$b} cmp $r->{$a} } keys %$r ];
  42             },
  43     R   => sub {        # Sort reverse
  44             my $r = shift;
  45             [ reverse sort                           keys %$r ];
  46             },
  47     );
  48 my $_sortkeys = 1;
  49
  50 sub DDsort
  51 {
  52     @_ or return;
  53
  54     $_sortkeys = exists $sk{$_[0]} ? $sk{$_[0]} : $_[0];
  55     } # DDsort
  56
  57 sub import
  58 {
  59     my @exp = @_;
  60     my @etl;
  61     foreach my $p (@exp) {
  62         exists $sk{$p} and DDsort ($p), next;
  63
  64         push @etl, $p;
  65         }
  66     __PACKAGE__->export_to_level (1, @etl);
  67     } # import
  68
  69 sub DDumper
  70 {
  71     local $Data::Dumper::Sortkeys = $_sortkeys;
  72     local $Data::Dumper::Indent   = 1;
  73
  74     my $s = Data::Dumper::Dumper @_;
  75     $s =~ s!^(\s*)'([^']*)'\s*=>!sprintf "%s%-16s =>", $1, $2!gme;      # Align => '
  76     $s =~ s!\bbless\s*\(\s*!bless (!gm and $s =~ s!\s+\)([;,])$!)$1!gm;
  77     $s =~ s!^(?= *[]}](?:[;,]|$))!  !gm;
  78     $s =~ s!^(\s+)!$1$1!gm;
  79
  80     defined wantarray or print STDERR $s;
  81     return $s;
  82     } # DDumper
  83
  84 ### ############# DDump () ####################################################
  85
  86 our $has_perlio;
  87
  88 BEGIN {
  89     use Config;
  90     $has_perlio = ($Config{useperlio} || "undef") eq "define";
  91     }
  92
  93 sub _DDump_ref
  94 {
  95     my ($var, $down) = (@_, 0);
  96
  97     my $ref = ref $var;
  98     if ($ref eq "SCALAR" || $ref eq "REF") {
  99         my %hash = DDump ($$var, $down);
 100         return { %hash };
 101         }
 102     if ($ref eq "ARRAY") {
 103         my @list;
 104         foreach my $list (@$var) {
 105             my %hash = DDump ($list, $down);
 106             push @list, { %hash };
 107             }
 108         return [ @list ];
 109         }
 110     if ($ref eq "HASH") {
 111         my %hash;
 112         foreach my $key (sort keys %$var) {
 113             $hash{DPeek ($key)} = { DDump ($var->{$key}, $down) };
 114             }
 115         return { %hash };
 116         }
 117     undef;
 118     } # _DDump_ref
 119
 120 sub _DDump
 121 {
 122     my ($var, $down, $dump, $fh) = (@_, "");
 123
 124     if ($has_perlio and open $fh, ">", \$dump) {
 125         #print STDERR "Using DDump_IO\n";
 126         DDump_IO ($fh, $var, $down);
 127         close $fh;
 128         }
 129     else {
 130         #print STDERR "Using DDump_XS\n";
 131         $dump = DDump_XS ($var);
 132         }
 133
 134     return $dump;
 135     } # _DDump
 136
 137 sub DDump ($;$)
 138 {
 139     my ($var, $down) = (@_, 0);
 140     my @dump = split m/[\r\n]+/, _DDump ($var, wantarray || $down) or return;
 141
 142     if (wantarray) {
 143         my %hash;
 144         ($hash{sv} = $dump[0]) =~ s/^SV\s*=\s*//;
 145         m/^\s+(\w+)\s*=\s*(.*)/ and $hash{$1} = $2 for @dump;
 146
 147         if (exists $hash{FLAGS}) {
 148             $hash{FLAGS} =~ tr/()//d;
 149             $hash{FLAGS} = { map { $_ => 1 } split m/,/ => $hash{FLAGS} };
 150             }
 151
 152         $down && ref $var and
 153             $hash{RV} = _DDump_ref ($var, $down - 1) || $var;
 154         return %hash;
 155         }
 156
 157     my $dump = join "\n", @dump, "";
 158
 159     defined wantarray and return $dump;
 160
 161     print STDERR $dump;
 162     } # DDump
 163
 164 "Indent";
 165
 166 __END__
 167
 168 =head1 NAME
 169
 170 Data::Peek - A collection of low-level debug facilities
 171
 172 =head1 SYNOPSIS
 173
 174  use Data::Peek;
 175
 176  print DDumper \%hash;    # Same syntax as Data::Dumper
 177
 178  print DPeek \$var;
 179  my ($pv, $iv, $nv, $rv, $magic) = DDual ($var [, 1]);
 180  print DPeek for DDual ($!, 1);
 181  print DDisplay ("ab\nc\x{20ac}\rdef\n");
 182
 183  my $dump = DDump $var;
 184  my %hash = DDump \@list;
 185  DDump \%hash;
 186
 187  my %hash = DDump (\%hash, 5);  # dig 5 levels deep
 188
 189  my $dump;
 190  open my $fh, ">", \$dump;
 191  DDump_IO ($fh, \%hash, 6);
 192  close $fh;
 193  print $dump;
 194
 195  use Data::Peek qw( triplevar );
 196  my $tv = triplevar ("\N{GREEK SMALL LETTER PI}", 3, "3.1415");
 197
 198 =head1 DESCRIPTION
 199
 200 Data::Peek started off as C<DDumper> being a wrapper module over
 201 L<Data::Dumper>, but grew out to be a set of low-level data
 202 introspection utilities that no other module provided yet, using the
 203 lowest level of the perl internals API as possible.
 204
 205 =head2 DDumper ($var, ...)
 206
 207 Not liking the default output of Data::Dumper, and always feeling the need
 208 to set C<$Data::Dumper::Sortkeys = 1;>, and not liking any of the default
 209 layouts, this function is just a wrapper around Data::Dumper::Dumper with
 210 everything set as I like it.
 211
 212     $Data::Dumper::Sortkeys = 1;
 213     $Data::Dumper::Indent   = 1;
 214
 215 And the result is further beautified to meet my needs:
 216
 217   * quotation of hash keys has been removed (with the disadvantage
 218     that the output might not be parseable again).
 219   * arrows for hashes are aligned at 16 (longer keys don't align)
 220   * closing braces and brackets are now correctly aligned
 221
 222 In void context, C<DDumper ()> prints to STDERR.
 223
 224 Example
 225
 226   print DDumper { ape => 1, foo => "egg", bar => [ 2, "baz", undef ]};
 227
 228   $VAR1 = {
 229       ape              => 1,
 230       bar              => [
 231           2,
 232           'baz',
 233           undef
 234           ],
 235       foo              => 'egg'
 236       };
 237
 238 =head2 DDsort ( 0 | 1 | R | V | VR | VN | VNR )
 239
 240 Set the hash sort algorithm for DDumper. The default is to sort by key value.
 241
 242   0   - Do not sort
 243   1   - Sort by key
 244   R   - Reverse sort by key
 245   V   - Sort by value
 246   VR  - Reverse sort by value
 247   VN  - Sort by value numerical
 248   VNR - Reverse sort by value numerical
 249
 250 These can also be passed to import:
 251
 252   $ perl -MDP=VNR -we'DDumper { foo => 1, bar => 2, zap => 3, gum => 13 }'
 253   $VAR1 = {
 254       gum              => 13,
 255       zap              => 3,
 256       bar              => 2,
 257       foo              => 1
 258       };
 259   $ perl -MDP=V   -we'DDumper { foo => 1, bar => 2, zap => 3, gum => 13 }'
 260   $VAR1 = {
 261       foo              => 1,
 262       gum              => 13,
 263       bar              => 2,
 264       zap              => 3
 265       };
 266
 267 =head2 DPeek
 268
 269 =head2 DPeek ($var)
 270
 271 Playing with C<sv_dump ()>, I found C<Perl_sv_peek ()>, and it might be
 272 very useful for simple checks. If C<$var> is omitted, uses $_.
 273
 274 Example
 275
 276   print DPeek "abc\x{0a}de\x{20ac}fg";
 277
 278   PV("abc\nde\342\202\254fg"\0) [UTF8 "abc\nde\x{20ac}fg"]
 279
 280 =head2 DDisplay
 281
 282 =head2 DDisplay ($var)
 283
 284 Show the PV content of a scalar the way perl debugging would have done.
 285 UTF-8 detection is on, so this is effectively the same as returning the
 286 first part the C<DPeek ()> returns for non-UTF8 PV's or the second part
 287 for UTF-8 PV's. C<DDisplay ()> returns the empty string for scalars that
 288 no have a valid PV.
 289
 290 Example
 291
 292   print DDisplay "abc\x{0a}de\x{20ac}fg";
 293
 294   "abc\nde\x{20ac}fg"
 295
 296 =head2 my ($pv, $iv, $nv, $rv, $hm) = DDual ($var [, $getmagic])
 297
 298 DDual will return the basic elements in a variable, guaranteeing that no
 299 conversion takes place. This is very useful for dual-var variables, or
 300 when checking is a variable has defined entries for a certain type of
 301 scalar. For each String (PV), Integer (IV), Double (NV), and Reference (RV),
 302 the current value of C<$var> is returned or undef if it is not set (yet).
 303 The 5th element is an indicator if C<$var> has magic, which is B<not> invoked
 304 in the returned values, unless explicitly asked for with a true optional
 305 second argument.
 306
 307 Example
 308
 309   print DPeek for DDual ($!, 1);
 310
 311 =head2 triplevar ($pv, $iv, $nv)
 312
 313 When making C<DDual ()> I wondered if it were possible to create triple-val
 314 scalar variables. L<Scalar::Util> already gives us C<dualvar ()>, that creates
 315 you a scalar with different numeric and string values that return different
 316 values in different context. Not that C<triplevar ()> would be very useful,
 317 compared to C<dualvar ()>, but at least this shows that it is possible.
 318
 319 C<triplevar ()> is not exported by default.
 320
 321 Example:
 322
 323   print DPeek for DDual
 324       Data::Peek::triplevar ("\N{GREEK SMALL LETTER PI}", 3, 3.1415);
 325
 326   PV("\317\200"\0) [UTF8 "\x{3c0}"]
 327   IV(3)
 328   NV(3.1415)
 329   SV_UNDEF
 330   IV(0)
 331
 332 =head2 DDump ($var [, $dig_level])
 333
 334 A very useful module when debugging is C<Devel::Peek>, but is has one big
 335 disadvantage: it only prints to STDERR, which is not very handy when your
 336 code wants to inspect variables al a low level.
 337
 338 Perl itself has C<sv_dump ()>, which does something similar, but still
 339 prints to STDERR, and only one level deep.
 340
 341 C<DDump ()> is an attempt to make the innards available to the script level
 342 with a reasonable level of compatibility. C<DDump ()> is context sensitive.
 343
 344 In void context, it behaves exactly like C<Perl_sv_dump ()>.
 345
 346 In scalar context, it returns what C<Perl_sv_dump ()> would have printed.
 347
 348 In list context, it returns a hash of the variable's properties. In this mode
 349 you can pass an optional second argument that determines the depth of digging.
 350
 351 Example
 352
 353   print scalar DDump "abc\x{0a}de\x{20ac}fg"
 354
 355   SV = PV(0x723250) at 0x8432b0
 356     REFCNT = 1
 357     FLAGS = (PADBUSY,PADMY,POK,pPOK,UTF8)
 358     PV = 0x731ac0 "abc\nde\342\202\254fg"\0 [UTF8 "abc\nde\x{20ac}fg"]
 359     CUR = 11
 360     LEN = 16
 361
 362   my %h = DDump "abc\x{0a}de\x{20ac}fg";
 363   print DDumper \%h;
 364
 365   $VAR1 = {
 366       CUR              => '11',
 367       FLAGS            => {
 368           PADBUSY          => 1,
 369           PADMY            => 1,
 370           POK              => 1,
 371           UTF8             => 1,
 372           pPOK             => 1
 373           },
 374       LEN              => '16',
 375       PV               => '0x731ac0 "abc\\nde\\342\\202\\254fg"\\0 [UTF8 "abc\\nde\\x{20ac}fg"]',
 376       REFCNT           => '1',
 377       sv               => 'PV(0x723250) at 0x8432c0'
 378       };
 379
 380   my %h = DDump {
 381       ape => 1,
 382       foo => "egg",
 383       bar => [ 2, "baz", undef ],
 384       }, 1;
 385   print DDumper \%h;
 386
 387   $VAR1 = {
 388       FLAGS            => {
 389           PADBUSY          => 1,
 390           PADMY            => 1,
 391           ROK              => 1
 392           },
 393       REFCNT           => '1',
 394       RV               => {
 395           PVIV("ape")      => {
 396               FLAGS            => {
 397                   IOK              => 1,
 398                   PADBUSY          => 1,
 399                   PADMY            => 1,
 400                   pIOK             => 1
 401                   },
 402               IV               => '1',
 403               REFCNT           => '1',
 404               sv               => 'IV(0x747020) at 0x843a10'
 405               },
 406           PVIV("bar")      => {
 407               CUR              => '0',
 408               FLAGS            => {
 409                   PADBUSY          => 1,
 410                   PADMY            => 1,
 411                   ROK              => 1
 412                   },
 413               IV               => '1',
 414               LEN              => '0',
 415               PV               => '0x720210 ""',
 416               REFCNT           => '1',
 417               RV               => '0x720210',
 418               sv               => 'PVIV(0x7223e0) at 0x843a10'
 419               },
 420           PVIV("foo")      => {
 421               CUR              => '3',
 422               FLAGS            => {
 423                   PADBUSY          => 1,
 424                   PADMY            => 1,
 425                   POK              => 1,
 426                   pPOK             => 1
 427                   },
 428               IV               => '1',
 429               LEN              => '8',
 430               PV               => '0x7496c0 "egg"\\0',
 431               REFCNT           => '1',
 432               sv               => 'PVIV(0x7223e0) at 0x843a10'
 433               }
 434           },
 435       sv               => 'RV(0x79d058) at 0x843310'
 436       };
 437
 438 =head2 DDump_IO ($io, $var [, $dig_level])
 439
 440 A wrapper function around perl's internal C<Perl_do_sv_dump ()>, which
 441 makes C<Devel::Peek> completely superfluous. As PerlIO is only available
 442 perl version 5.7.3 and up, this function is not available in older perls.
 443
 444 Example
 445
 446   my $dump;
 447   open my $eh, ">", \$dump;
 448   DDump_IO ($eh, { 3 => 4, ape => [5..8]}, 6);
 449   close $eh;
 450   print $dump;
 451
 452   SV = RV(0x79d9e0) at 0x843f00
 453     REFCNT = 1
 454     FLAGS = (TEMP,ROK)
 455     RV = 0x741090
 456       SV = PVHV(0x79c948) at 0x741090
 457         REFCNT = 1
 458         FLAGS = (SHAREKEYS)
 459         IV = 2
 460         NV = 0
 461         ARRAY = 0x748ff0  (0:7, 2:1)
 462         hash quality = 62.5%
 463         KEYS = 2
 464         FILL = 1
 465         MAX = 7
 466         RITER = -1
 467         EITER = 0x0
 468           Elt "ape" HASH = 0x97623e03
 469           SV = RV(0x79d9d8) at 0x8440e0
 470             REFCNT = 1
 471             FLAGS = (ROK)
 472             RV = 0x741470
 473               SV = PVAV(0x7264b0) at 0x741470
 474                 REFCNT = 2
 475                 FLAGS = ()
 476                 IV = 0
 477                 NV = 0
 478                 ARRAY = 0x822f70
 479                 FILL = 3
 480                 MAX = 3
 481                 ARYLEN = 0x0
 482                 FLAGS = (REAL)
 483                   Elt No. 0
 484                   SV = IV(0x7467c8) at 0x7c1aa0
 485                     REFCNT = 1
 486                     FLAGS = (IOK,pIOK)
 487                     IV = 5
 488                   Elt No. 1
 489                   SV = IV(0x7467b0) at 0x8440f0
 490                     REFCNT = 1
 491                     FLAGS = (IOK,pIOK)
 492                     IV = 6
 493                   Elt No. 2
 494                   SV = IV(0x746810) at 0x75be00
 495                     REFCNT = 1
 496                     FLAGS = (IOK,pIOK)
 497                     IV = 7
 498                   Elt No. 3
 499                   SV = IV(0x746d38) at 0x7799d0
 500                     REFCNT = 1
 501                     FLAGS = (IOK,pIOK)
 502                     IV = 8
 503           Elt "3" HASH = 0xa400c7f3
 504           SV = IV(0x746fd0) at 0x7200e0
 505             REFCNT = 1
 506             FLAGS = (IOK,pIOK)
 507             IV = 4
 508
 509 =head1 INTERNALS
 510
 511 C<DDump ()> uses an XS wrapper around C<Perl_sv_dump ()> where the
 512 STDERR is temporarily caught to a pipe. The internal XS helper functions
 513 are not meant for user space
 514
 515 =head2 DDump_XS (SV *sv)
 516
 517 Base interface to internals for C<DDump ()>.
 518
 519 =head1 BUGS
 520
 521 Windows and AIX might be using a build where not all symbols that were
 522 supposed to be exported in the public API are not. Perl_pv_peek () is
 523 one of them.
 524
 525 Not all types of references are supported.
 526
 527 It might crash.
 528
 529 No idea how far back this goes in perl support, but Devel::PPPort has
 530 proven to be a big help.
 531
 532 =head1 SEE ALSO
 533
 534 L<Devel::Peek(3)>, L<Data::Dumper(3)>, L<Data::Dump(3)>,
 535 L<Data::Dump::Streamer(3)>
 536
 537 =head1 AUTHOR
 538
 539 H.Merijn Brand <h.m.brand@xs4all.nl>
 540
 541 =head1 COPYRIGHT AND LICENSE
 542
 543 Copyright (C) 2008-2009 H.Merijn Brand
 544
 545 This library is free software; you can redistribute it and/or modify
 546 it under the same terms as Perl itself.
 547
 548 =cut