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