Data-Printer

 view release on metacpan or  search on metacpan

examples/try_me.pl  view on Meta::CPAN

#!/usr/bin/env perl
use strict;
use warnings;
use Scalar::Util qw(weaken);

# This sample code is available to you so you
# can see Data::Printer working out of the box.
# It can be used as a quick way to test your
# color palette scheme!
package My::BaseClass;
sub whatever {}

package My::SampleClass;
use base 'My::BaseClass';

examples/try_me.pl  view on Meta::CPAN

  readonly => \2,
  boolean => [1 == 1, 1 == 2],
  regexp => qr/foo.*bar/i,
  glob   => \*STDOUT,
  code   => sub { return 42 },
  class  => $obj,
};


$sample->{weakref} = $sample;
weaken $sample->{weakref};

BEGIN { $ENV{DATAPRINTERRC} = '' };  # <-- skip user's .dataprinter

use DDP show_memsize  => 1,
        show_refcount => 1,
        class => {
            format_inheritance => 'lines',
            inherited  => 'public',
            linear_isa => 1
        };

lib/Data/Printer/Common.pm  view on Meta::CPAN

}

sub _get_namespace {
    my ($class_name) = @_;
    my $namespace;
    {
        no strict 'refs';
        $namespace = \%{ $class_name . '::' }
    }
    # before 5.10, stashes don't ever seem to drop to a refcount of zero,
    # so weakening them isn't helpful
    Scalar::Util::weaken($namespace) if $] >= 5.010;

    return $namespace;
}

sub _get_superclasses_for {
    my ($class_name) = @_;
    my $namespace = _get_namespace($class_name);
    my $res = _get_symbol($class_name, $namespace, 'ISA', 'ARRAY');
    return @{ $res || [] };
}

lib/Data/Printer/Filter/ARRAY.pm  view on Meta::CPAN

    }

    return $ddp->maybe_colorize('[]', 'brackets') . $tied
        unless @$array_ref;
    return $ddp->maybe_colorize('[', 'brackets')
         . $ddp->maybe_colorize('...', 'array')
         . $ddp->maybe_colorize(']', 'brackets')
         . $tied
         if $ddp->max_depth && $ddp->current_depth >= $ddp->max_depth;

    #Scalar::Util::weaken($array_ref);
    my $string = $ddp->maybe_colorize('[', 'brackets');

    my @i = Data::Printer::Common::_fetch_indexes_for($array_ref, 'array', $ddp);

    # when showing array index, we must add the padding for newlines:
    my $has_index = $ddp->index;
    my $local_padding = 0;
    if ($has_index) {
        my $last_index;
        # Get the last index shown to add the proper padding.

t/002-scalar.t  view on Meta::CPAN

test_max_string();
test_weak_ref();
test_readonly();
test_dualvar_lax();
test_dualvar_strict();
test_dualvar_off();

sub test_weak_ref {
    my $num = 3.14;
    my $ref = \$num;
    Scalar::Util::weaken($ref);
    my $ddp = Data::Printer::Object->new( colored => 0 );
    is $ddp->parse($ref), '3.14 (weak)', 'parse() after weaken';
}

sub test_basic_values {
    my $object = Data::Printer::Object->new( colored => 0 );

    # hardcoded values:
    is $object->parse(\undef)  , 'undef (read-only)'  , 'hardcoded undef value';
    is $object->parse(\123)    , '123 (read-only)'    , 'hardcoded integer value';
    is $object->parse(\0)      , '0 (read-only)'      , 'hardcoded integer value';
    is $object->parse(\123.456), '123.456 (read-only)', 'hardcoded floating point value';

t/003-ref.t  view on Meta::CPAN

my $doublecheck = $ddp->parse(\$ref2ref);
is $doublecheck, $res, 'checking again gives the same result (previously seen addresses)';

$ddp = Data::Printer::Object->new( colored => 0, show_readonly => 0 );
$res = $ddp->parse(\\$ref2ref);
is $res, q(\\ \\ \\ "test"), 'ref2ref2ref2scalar';

my $x = [];
my $y = $x;
Scalar::Util::weaken($y);
is $ddp->parse($x), '[]', 'regular array ref';
is $ddp->parse($y), '[] (weak)', 'weak array ref';
$x->[0] = $x;
Scalar::Util::weaken($x->[0]);
is $ddp->parse($x), '[
    [0] var (weak)
]', 'circular array';

my $array_of_refs = [\1, \2];
$res = $ddp->parse($array_of_refs);
is $res, '[
    [0] \ 1,
    [1] \ 2
]', 'proper results when 2 references present on the same array (regression)';

t/009-array.t  view on Meta::CPAN

is $res,
'[
    [0] 3.14,
    [1] "test",
    [2] undef,
    [3] var
]',
'array with elements and circular ref';

$ddp = Data::Printer::Object->new( colored => 0 );
Scalar::Util::weaken($array[3]);
$res = $ddp->parse(\@array);
is $res,
'[
    [0] 3.14,
    [1] "test",
    [2] undef,
    [3] var (weak)
]',
'array with elements and WEAK circular ref';

t/013-refcount.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More tests => 17;
use Data::Printer::Object;
use Scalar::Util qw(weaken isweak);
use B;

test_scalar_refcount();
test_hash_refcount();
test_array_refcount();

exit;

sub test_array_refcount {
    my $var = [42];
    my $count; eval { $count = B::svref_2object($var)->REFCNT };
    push @$var, $var;

    my $count2; eval { $count2 = B::svref_2object($var)->REFCNT };
    ok $count2 > $count, "array: $count2 > $count";
    my $ddp = Data::Printer::Object->new( colored => 0, show_refcount => 1 );
    is $ddp->parse($var), '[
    [0] 42,
    [1] var
] (refcount: 2)', 'circular array ref';
    weaken($var->[-1]);
    my $count3; eval { $count3 = B::svref_2object($var)->REFCNT };
    ok $count3 == $count, "array: $count3 == $count";
    is_deeply($ddp->{_seen}, {}, 'ensure proper internal structure (array)');

    is $ddp->parse($var), '[
    [0] 42,
    [1] var (weak)
]', 'circular array ref (weakened)';


    my $data2 = [[10]];
    push @{$data2}, $data2->[0];
    my $out = $ddp->parse( \$data2 );
    my @times_matched = $out =~ /refcount:/g;
    is(@times_matched, 1, 'found (refcount: 2) only once') or diag $out;
}

sub test_hash_refcount {

t/013-refcount.t  view on Meta::CPAN

    $var->{self} = $var;
    my $count2; eval { $count2 = B::svref_2object($var)->REFCNT };
    ok $count2 > $count, "hash: $count2 > $count";

    my $ddp = Data::Printer::Object->new( colored => 0, show_refcount => 1 );
    is ($ddp->parse($var), '{
    foo    42,
    self   var
} (refcount: 2)', 'circular hash ref');

    weaken($var->{self});
    my $count3; eval { $count3 = B::svref_2object($var)->REFCNT };
    ok $count3 == $count, "hash: $count3 == $count";
    is_deeply($ddp->{_seen}, {}, 'ensure proper internal structure (hash)');
    is ($ddp->parse($var), '{
    foo    42,
    self   var (weak)
}', 'circular hash ref (weakened)');
}

sub test_scalar_refcount {
    my $ddp = Data::Printer::Object->new( colored => 0, show_refcount => 1 );
    my $var;
    my $count; eval { $count = B::svref_2object(\$var)->REFCNT };
    $var = \$var;

    my $count2; eval { $count2 = B::svref_2object(\$var)->REFCNT };
    ok $count2 > $count, "scalar: $count2 > $count";
    is $ddp->parse($var), '\\ var (refcount: 2)', 'circular scalar ref';
    is $ddp->parse($var), '\\ var (refcount: 2)', 'circular scalar ref (retest)';
    weaken($var);
    my $count3; eval { $count3 = B::svref_2object(\$var)->REFCNT };
    ok $count3 == $count, "scalar: $count3 == $count";
    is $ddp->parse($var), '\\ var (weak)', 'circular scalar ref (weakened)';
    my $ref = \$var;
    $ddp = Data::Printer::Object->new( colored => 0, show_refcount => 1 );
    is $ddp->parse($ref), '\\ var (weak) (refcount: 2)', 'circular scalar ref (weakened)';
}

t/021-p_vs_object.t  view on Meta::CPAN

        is $pretty, qq("$tainted" (TAINTED)), 'found taint flag with p()';

        my $pretty_np = np $tainted;
        is $pretty_np, $pretty, 'found taint flag with np()';
    };
}

sub test_weak_ref {
    my $num = 3.14;
    my $ref = \$num;
    Scalar::Util::weaken($ref);
    my $pretty = p $ref;
    is $pretty, '\ 3.14 (weak)', 'found weak flag with p()';
    my $pretty_np = np $ref;
    is $pretty_np, $pretty, 'found weak flag with np()';
}

sub test_refcount {
    my $array = [42];
    push @$array, $array;
    my $pretty = p $array;

t/021-p_vs_object.t  view on Meta::CPAN

    my $pretty_np = np $array;
    is $pretty_np, $pretty, 'circular array (np)';

    my @simple_array = (42);
    push @simple_array, \@simple_array;
    $pretty = p @simple_array;
    is $pretty, '[ 42, var ] (refcount: 2)', 'circular (simple) array';
    $pretty_np = np @simple_array;
    is $pretty_np, $pretty, 'circular (simple) array (np)';

    Scalar::Util::weaken($array->[-1]);
    $pretty = p $array;
    is $pretty, '[ 42, var (weak) ]', 'circular (weak) array';
    $pretty_np = np $array;
    is $pretty_np, $pretty, 'circular (weak) array (np)';

    my %hash = ( foo => 42 );
    $hash{self} = \%hash;
    $pretty = p %hash;
    is $pretty, '{ foo:42, self:var } (refcount: 2)', 'circular (simple) hash';
    $pretty_np = np %hash;

t/021-p_vs_object.t  view on Meta::CPAN

    is $pretty, '{ foo:42, self:var } (refcount: 2)', 'circular hash';
    $pretty_np = np $hash;
    is $pretty_np, $pretty, 'circular hash (np)';

    my $other_hash = $hash;
    $pretty = p $other_hash;
    is $pretty, '{ foo:42, self:var } (refcount: 3)', 'circular hash with extra ref';
    $pretty_np = np $other_hash;
    is $pretty_np, $pretty, 'circular hash with extra ref (np)';

    Scalar::Util::weaken($hash->{self});
    undef $other_hash;
    $pretty = p $hash;
    is $pretty, '{ foo:42, self:var (weak) }', 'circular (weak) hash';
    $pretty_np = np $hash;
    is $pretty_np, $pretty, 'circular (weak) hash (np)';

    my $scalar;
    $scalar = \$scalar;
    $pretty = p $scalar;
    is $pretty, '\\ var (refcount: 2)', 'circular scalar ref';

t/021-p_vs_object.t  view on Meta::CPAN

    $pretty = p $blessed;
    is $pretty, 'Something', 'blessed ref';
    $pretty_np = np $blessed;
    is $pretty_np, $pretty, 'blessed ref (np)';

    my $blessed2 = $blessed;
    $pretty = p $blessed2;
    is $pretty, 'Something (refcount: 2)', 'blessed ref (high refcount)';
    $pretty_np = np $blessed2;
    is $pretty_np, $pretty, 'blessed ref (high refcount) (np)';
    Scalar::Util::weaken($blessed2);
    $pretty = p $blessed2;
    is $pretty, 'Something (weak)', 'blessed ref (weak)';
    $pretty_np = np $blessed2;
    is $pretty_np, $pretty, 'blessed ref (weak) (np)';
}