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