Subject: | Show weak references |
I propose a patch to add a mark to weak references (especially useful
when debugging circular structures). Tests are present.
Note about class refs parsing: i changed the way class (named
ref->content) recursion happens, instead of copying all data (thus,
losing any flags that were on the original data and adding memory
overhead for having those copies), i just pass a "we're recursing" flag,
that gets cleared after processing.
Subject: | data-printer.weak.diff |
--- lib/Data/Printer.pm
+++ lib/Data/Printer.pm
@@ -47,7 +47,8 @@
'code' => 'green',
'glob' => 'bright_cyan',
'repeated' => 'white on_red',
- 'caller_info' => 'bright_cyan'
+ 'caller_info' => 'bright_cyan',
+ 'weak' => 'cyan',
},
'class' => {
inherited => 'none', # also 0, 'none', 'public' or 'private'
@@ -223,17 +224,24 @@
sub _p {
my ($item, $p) = @_;
- my $ref = ref $item;
+ my $ref = defined $p->{_reftype} ? $p->{_reftype} : ref $item;
my $tie;
my $string = '';
# Object's unique ID, avoiding circular structures
my $id = Object::ID::object_id( $item );
- return colored($p->{_seen}->{$id}, $p->{color}->{repeated}
- ) if exists $p->{_seen}->{$id};
+ if ( exists $p->{_seen}->{$id} ) {
+ if ( !defined $p->{_reftype} ) {
+ $string .= colored($p->{_seen}->{$id}, $p->{color}->{repeated});
+ return $string;
+ }
+ }
+ else {
+ $p->{_seen}->{$id} = $p->{name};
+ }
- $p->{_seen}->{$id} = $p->{name};
+ delete $p->{_reftype}; # abort override
# filter item (if user set a filter for it)
if ( exists $p->{filters}->{$ref} ) {
@@ -268,6 +276,7 @@
qw(SCALAR CODE Regexp ARRAY HASH GLOB REF);
}
$string .= _p($$item, $p);
+ $string .= ' '.colored('(weak)', $p->{color}->{'weak'}) if Scalar::Util::isweak($$item);
}
elsif ($ref eq 'CODE') {
@@ -366,6 +375,7 @@
else {
$string .= _p( $array_elem, $p );
}
+ $string .= ' '.colored('(weak)', $p->{color}->{weak}) if $ref && Scalar::Util::isweak $item->[$i];
$string .= ($i == $#{$item} ? '' : ',') . $BREAK;
my $size = 2 + length($i); # [10], [100], etc
substr $p->{name}, -$size, $size, '';
@@ -420,6 +430,7 @@
else {
$string .= _p( $element, $p );
}
+ $string .= ' '.colored('(weak)', $p->{color}->{weak}) if $ref && Scalar::Util::isweak $item->{$key};
$string .= (--$total_keys == 0 ? '' : ',') . $BREAK;
my $size = 2 + length($key); # {foo}, {z}, etc
@@ -506,29 +517,11 @@
$string .= _show_methods($ref, $meta, $p);
if ( $p->{'class'}->{'internals'} ) {
- my $realtype = Scalar::Util::reftype $item;
$string .= (' ' x $p->{_current_indent})
. 'internals: ';
-
- # Note: we can't do p($$item) directly
- # or we'd fall in a deep recursion trap
- if ($realtype eq 'HASH') {
- my %realvalue = %$item;
- $string .= _p(\%realvalue, $p);
- }
- elsif ($realtype eq 'ARRAY') {
- my @realvalue = @$item;
- $string .= _p(\@realvalue, $p);
- }
- elsif ($realtype eq 'CODE') {
- my $realvalue = &$item;
- $string .= _p(\$realvalue, $p);
- }
- # SCALAR and friends
- else {
- my $realvalue = $$item;
- $string .= _p(\$realvalue, $p);
- }
+
+ local $p->{_reftype} = Scalar::Util::reftype $item;
+ $string .= _p($item, $p);
$string .= $BREAK;
}
@@ -697,7 +690,8 @@
code => 'green', # code references
glob => 'bright_cyan', # globs (usually file handles)
repeated => 'white on_red', # references to seen values
- caller_info => 'bright_cyan' # details on what's being printed
+ caller_info => 'bright_cyan' # details on what's being printed
+ weak => 'cyan', # mark for weak references
},
};
--- t/24-weak.t
+++ t/24-weak.t
@@ -0,0 +1,65 @@
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+ delete $ENV{ANSI_COLORS_DISABLED};
+ use File::HomeDir::Test; # avoid user's .dataprinter
+ use_ok ('Term::ANSIColor');
+ use_ok ('Scalar::Util', qw(weaken));
+ use_ok ('Data::Printer');
+};
+
+my $number = 3.14;
+my $n_ref = \$number;
+weaken($n_ref);
+is( p($n_ref), color('reset') . '\\ '
+ . colored($number, 'bright_blue')
+ . colored(' (weak)', 'cyan')
+, 'weakened ref');
+
+
+my $circular = [];
+$circular->[0] = $circular;
+weaken($circular->[0]);
+is( p($circular), color('reset') . "\\ [$/ "
+ . colored('[0] ', 'bright_white')
+ . colored('var', 'white on_red')
+ . colored(' (weak)', 'cyan')
+ . "$/]"
+, 'weakened circular array ref');
+
+
+
+my %hash = ();
+$hash{key} = \%hash;
+weaken($hash{key});
+is( p(%hash), color('reset') . "{$/ "
+ . colored('key', 'magenta')
+ . ' '
+ . colored('var', 'white on_red')
+ . colored(' (weak)', 'cyan')
+ . "$/}"
+, 'weakened circular hash ref');
+
+package Foo;
+sub new {my $s = bless [], shift; $s->[0] = $s; Scalar::Util::weaken($s->[0]); return $s }
+
+package main;
+
+my $obj = Foo->new;
+
+is( p($obj), 'Foo {
+ public methods (1) : new
+ private methods (0)
+ internals: [
+ '
+ . colored('[0] ', 'bright_white')
+ . colored('var', 'white on_red')
+ . colored(' (weak)', 'cyan').'
+ ]
+}', 'circular weak ref to object' );
+
+
+
+done_testing;