Skip Menu |

Preferred bug tracker

Please visit the preferred bug tracker to report your issue.

This queue is for tickets about the Data-Printer CPAN distribution.

Report information
The Basics
Id: 68594
Status: resolved
Priority: 0/
Queue: Data-Printer

People
Owner: Nobody in particular
Requestors: RANDIR [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: 0.18



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;
On Wed Jun 01 08:52:13 2011, RANDIR wrote: Show quoted text
> 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.
Very nice indeed. Thanks for the patch! I just released version 0.18, it should contain your proposed changes. As soon as you confirm it's like you expected we can close this ticket :) Thanks again
Thanks, it looks good.