Devel-Cycle
view release on metacpan or search on metacpan
- Fixed export_to_level() problem so that Test::Memory::Cycle works again.
1.06 Tue May 23 17:08:22 EDT 2006
- Removed debugging warning.
- Only checks CODErefs if PadWalker version >= 1.0.
1.05 May 18 2006
- Added ability to detect cycles in CODErefs courtesy Yuval Kogman.
1.04
- Added ability to detect weakened cycles courtesy Stevan Little
1.03 Fri Jan 21 13:47:50 EST 2005
- Sort the hash keys so that the cycle path is more deterministic
(avoids test failures in Test::Memory::Cycle)
1.02 Mon Jan 12 09:04:58 EST 2004
- Formats anonymous memory references by default as \%A, \@B, etc,
rather than using hex form.
- Options to control memory reference formatting.
1.01 Sun Dec 14 16:57:58 EST 2003
- Added code to skip weak refs created with Scalar::Util's
weaken(). (Sam Tregar)
- Improved formatting in output.
1.00 Sat Dec 13 11:04:57 2003
- original version
lib/Devel/Cycle.pm view on Meta::CPAN
use Scalar::Util qw(isweak blessed refaddr reftype);
my $SHORT_NAME = 'A';
my %SHORT_NAMES;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(find_cycle find_weakened_cycle);
our @EXPORT_OK = qw($FORMATTING);
our $VERSION = '1.12';
our $FORMATTING = 'roasted';
our $QUIET = 0;
my %import_args = (-quiet =>1,
-raw =>1,
-cooked =>1,
-roasted=>1);
lib/Devel/Cycle.pm view on Meta::CPAN
my $self = shift;
my @args = @_;
my %args = map {$_=>1} @args;
$QUIET++ if exists $args{-quiet};
$FORMATTING = 'roasted' if exists $args{-roasted};
$FORMATTING = 'raw' if exists $args{-raw};
$FORMATTING = 'cooked' if exists $args{-cooked};
$self->export_to_level(1,$self,grep {!exists $import_args{$_}} @_);
}
sub find_weakened_cycle {
my $ref = shift;
my $callback = shift;
unless ($callback) {
my $counter = 0;
$callback = sub {
_do_report(++$counter,shift)
}
}
_find_cycle($ref,{},$callback,1,{},());
}
lib/Devel/Cycle.pm view on Meta::CPAN
Cycle (3):
$A->{'fred'} => \@A
$A->[3] => \%B
$B->{'phyllis'} => \%A
Cycle (4):
$A->{'fred'} => \@A
$A->[3] => \%B
$B->{'mary'} => \@A
# you can also check weakened references
weaken($test->{george}->{phyllis});
find_weakened_cycle($test);
exit 0;
# output:
Cycle (1):
$A->{'george'} => \%B
$B->{'mary'} => \@C
$C->[3] => \%B
Cycle (2):
lib/Devel/Cycle.pm view on Meta::CPAN
=head1 DESCRIPTION
This is a simple developer's tool for finding circular references in
objects and other types of references. Because of Perl's
reference-count based memory management, circular references will
cause memory leaks.
=head2 EXPORT
The find_cycle() and find_weakened_cycle() subroutine are exported by default.
=over 4
=item find_cycle($object_reference,[$callback])
The find_cycle() function will traverse the object reference and print
a report to STDOUT identifying any memory cycles it finds.
If an optional callback code reference is provided, then this callback
will be invoked on each cycle that is found. The callback will be
lib/Devel/Cycle.pm view on Meta::CPAN
reference, and $reference_value is its dereferenced value. For
example, if the edge is an ARRAY, then the following relationship
holds:
$reference->[$index] eq $reference_value
The first element of the array reference is the $object_reference that
you pased to find_cycle() and may not be directly involved in the
cycle.
If a reference is a weak ref produced using Scalar::Util's weaken()
function then it won't contribute to cycles.
=item find_weakened_cycle($object_reference,[$callback])
The find_weakened_cycle() function will traverse the object reference and print
a report to STDOUT identifying any memory cycles it finds, I<including> any weakened
cycles produced using Scalar::Util's weaken().
If an optional callback code reference is provided, then this callback
will be invoked on each cycle that is found. The callback will be
passed an array reference pointing to a list of lists with the
following format:
$arg = [ ['REFTYPE',$index,$reference,$reference_value,$is_weakened],
['REFTYPE',$index,$reference,$reference_value,$is_weakened],
['REFTYPE',$index,$reference,$reference_value,$is_weakened],
...
]
Each element in the array reference describes one edge in the memory
cycle. 'REFTYPE' describes the type of the reference and is one of
'SCALAR','ARRAY' or 'HASH'. $index is the index affected by the
reference, and is undef for a scalar, an integer for an array
reference, or a hash key for a hash. $reference is the memory
reference, and $reference_value is its dereferenced value. $is_weakened
is a boolean specifying if the reference is weakened or not. For
example, if the edge is an ARRAY, then the following relationship
holds:
$reference->[$index] eq $reference_value
The first element of the array reference is the $object_reference that
you pased to find_cycle() and may not be directly involved in the
cycle.
=back
lib/Devel/Cycle.pm view on Meta::CPAN
memory locations, beginning with "A" and moving upward with the magic
++ operator. This leads to a much more readable display:
$Foo::Bar=B->{'phyllis'} => \%A
The "roasted" format is similar to the "cooked" format, except that
object references are formatted slightly differently:
$Foo::Bar::B->{'phyllis'} => \%A
If a reference is a weakened ref, then it will have a 'w->' prepended to
it, like this:
w-> $Foo::Bar::B->{'phyllis'} => \%A
For your convenience, $Devel::Cycle::FORMATTING can be imported:
use Devel::Cycle qw(:DEFAULT $FORMATTING);
$FORMATTING = 'raw';
Alternatively, you can control the formatting at compile time by
t/Devel-Cycle.t view on Meta::CPAN
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Devel-Cycle.t'
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More tests => 12;
use Scalar::Util qw(weaken isweak);
BEGIN { use_ok('Devel::Cycle') };
#########################
my $test = {fred => [qw(a b c d e)],
ethel => [qw(1 2 3 4 5)],
george => {martha => 23,
agnes => 19},
};
$test->{george}{phyllis} = $test;
t/Devel-Cycle.t view on Meta::CPAN
$test3 = \$test2;
my $counter = 0;
find_cycle($test,sub {$counter++});
is($counter,4,'found four cycles in $test');
$counter = 0;
find_cycle($test2,sub {$counter++});
is($counter,1,'found one cycle in $test2');
# now fix them with weaken and make sure that gets noticed
$counter = 0;
weaken($test->{george}->{phyllis});
find_cycle($test,sub {$counter++});
is($counter,2,'found two cycles in $test after weaken()');
# uncomment this to test the printing
# diag "Not Weak";
# find_cycle($test);
# diag "Weak";
# find_weakened_cycle($test);
$counter = 0;
find_weakened_cycle($test,sub {$counter++});
is($counter, 4, 'found four cycles (including weakened ones) in $test after weaken()');
$counter = 0;
weaken($test->{fred}[3]);
find_cycle($test,sub {$counter++});
is($counter,0,'found no cycles in $test after second weaken()');
$counter = 0;
find_weakened_cycle($test,sub {$counter++});
is($counter,4,'found four cycles (including weakened ones) in $test after second weaken()');
my $a = bless {},'foo';
my $b = bless {},'bar';
$a->{'b'} = $b;
$counter = 0;
find_cycle($a,sub {$counter++});
is($counter,0,'found no cycles in reference stringified on purpose to create a false alarm');
SKIP:
{
( run in 2.153 seconds using v1.01-cache-2.11-cpan-65fba6d93b7 )