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