Data-Decycle

 view release on metacpan or  search on metacpan

Makefile.PL  view on Meta::CPAN

    NAME                => 'Data::Decycle',
    AUTHOR              => q{Dan Kogai <dankogai+cpan@gmail.com>},
    VERSION_FROM        => 'lib/Data/Decycle.pm',
    ABSTRACT_FROM       => 'lib/Data/Decycle.pm',
    ($ExtUtils::MakeMaker::VERSION >= 6.3002
      ? ('LICENSE'=> 'perl')
      : ()),
    PL_FILES            => {},
    PREREQ_PM => {
        'Test::More' => 0,
	# 'PadWalker'  => 0,
    },
    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
    clean               => { FILES => 'Data-Decycle-*' },
);

lib/Data/Decycle.pm  view on Meta::CPAN

our @EXPORT    = ();
our @EXPORT_OK = qw(recsub $CALLEE
  may_leak has_cyclic_ref decycle_deeply weaken_deeply
);
our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_OK ], );

BEGIN {
    require constant;
    constant->import(
        HAS_PADWALKER => eval {
            require PadWalker;
            $PadWalker::VERSION >= 1.0;
        }
    );
}

sub new {
    my $class = shift;
    my $self = bless [], $class;
    $self->add(@_);
}

lib/Data/Decycle.pm  view on Meta::CPAN

                next unless ref $_;
                return 1 if $CALLEE->( $_, $_[1] );
            }
        }
        elsif (UNIVERSAL::isa( $_[0], 'SCALAR' )
            || UNIVERSAL::isa( $_[0], 'REF' ) )
        {
            return $CALLEE->( ${ $_[0] }, $_[1] );
        }
        elsif ( HAS_PADWALKER && UNIVERSAL::isa( $_[0], 'CODE' ) ) {
            my $r = PadWalker::closed_over( $_[0] );
            return unless keys %$r;
            $CALLEE->( $r, $_[1] ) && return 1;
        }
        return;
    }
}

*_has_cyclic_ref = _mkfinder { 1 };
sub has_cyclic_ref($){ _has_cyclic_ref($_[0], {}) }

lib/Data/Decycle.pm  view on Meta::CPAN

        }
        elsif ( UNIVERSAL::isa( $_[0], 'ARRAY' ) ) {
            $CALLEE->( $_, $_[1] ) for @{ $_[0] };
        }
        elsif (UNIVERSAL::isa( $_[0], 'SCALAR' )
            || UNIVERSAL::isa( $_[0], 'REF' ) )
        {
            $CALLEE->( ${ $_[0] }, $_[1] );
        }
        elsif ( HAS_PADWALKER && UNIVERSAL::isa( $_[0], 'CODE' ) ) {
            my $r = PadWalker::closed_over( $_[0] );
            return unless keys %$r;
            $CALLEE->( $r, $_[1] );
        }
        return;
    };
}

*_decycle_deeply = _mkwalker { undef $_[0] };
sub decycle_deeply($) { _decycle_deeply( $_[0], {} ) }

lib/Data/Decycle.pm  view on Meta::CPAN

      my $guard = Data::Decycle->new(
        my $cyclic_sref = \my $dummy,
        my $cyclic_aref = [],
        my $cyclic_href = {}
      );
      $cyclic_sref = \$cyclic_sref;
      $cyclic_aref->[0] = $cyclic_aref;
      $cyclic_href->{cyclic} = $cyclic_href;
  }

=head2 Code Reference and PadWalker

If you have PadWalker, you can decycle closures, too.

  {
      my $guard = Data::Decycle->new;
      my $cref;
      $cref = sub{ $_[0] <= 1 ? 1 : $_[0] * $cref->($_[0] - 1) };
      $guard->add($cref);
      print $cref->(10);
  }

=head2 Functional Interface

lib/Data/Decycle.pm  view on Meta::CPAN

What happens when it reaches out of the block?  $guard will surely be
DESTROY()'ed.  So it is guaranteed to trigger $guard->DESTROY.  And in
there it applys C<decycle_deeply> to each reference registered.

Simple, huh?

=head1 DEPENDENCY

None except for core modules.

To handle code references correctly, you need to have L<PadWalker> installed.

=head1 EXPORT

None by default.  Please import explicitly.

=head1 METHODS

=over 4

=item new

lib/Data/Decycle.pm  view on Meta::CPAN

=item * Search CPAN

L<http://search.cpan.org/dist/Data-Decycle/>

=back

=head1 ACKNOWLEDGEMENTS

=over 4

=item L<PadWalker>

You need this if you want to handle code references properly.  When
you don't have one this module simply does nothing when it encounters
them.

=item L<Devel::Cycle>

Good for inspection -- rather overkill.  Decycling features missing.

=back

t/01-has_scalar_ref.t  view on Meta::CPAN

$href->{cycle} = $href;
ok has_cyclic_ref($href), "'$href' is cyclic";

bless $aref, 'Dummy';
ok has_cyclic_ref($aref), "'$aref' is cyclic";

bless $href, 'Dummy';
ok has_cyclic_ref($href), "'$href' is cyclic";

SKIP:{
    skip 'PadWalker not installed', 3 unless Data::Decycle::HAS_PADWALKER;
    my $cref;
    $cref = sub{ $_[0] <= 1 ? 1 : $_[0] * $cref->($_[0] - 1) };
    ok has_cyclic_ref($cref), "'$cref' is cyclic";
    $cref = sub{ shift };
    ok !has_cyclic_ref($cref), "'$cref' isn't cyclic";
    $cref = recsub { $_[0] <= 1 ? 1 : $_[0] * $CALLEE->($_[0]-1) };
    ok !has_cyclic_ref($cref), "'$cref' isn't cyclic";
}

t/02-decycle_deeply.t  view on Meta::CPAN

ok !has_cyclic_ref($aref), "'$aref' isn't cyclic";

my $href = {foo => 0};
ok !has_cyclic_ref($href), "'$href' isn't cyclic";
$href->{cycle} = $href;
ok has_cyclic_ref($href), "'$href' is cyclic";
decycle_deeply($href);
ok !has_cyclic_ref($sref), "'$href' isn't cyclic";

SKIP:{
    skip 'PadWalker not installed', 5 unless Data::Decycle::HAS_PADWALKER;
    my $cref;
    $cref = sub{ $_[0] <= 1 ? 1 : $_[0] * $cref->($_[0] - 1) };
    ok has_cyclic_ref($cref), "'$cref' is cyclic";
    is $cref->(10), 3628800, "($cref)->(10) is 3628800";
    {
	no warnings 'uninitialized';
	decycle_deeply($cref);
	ok !has_cyclic_ref($cref), "'$sref' isn't cyclic";
    }
    $cref = sub{ shift };

t/04-may_leak.t  view on Meta::CPAN

ok !may_leak($aref), "'$aref' may not leak";

my $href = {foo => 0};
ok !may_leak($href), "'$href' may not leak";
$href->{cycle} = $href;
ok may_leak($href), "'$href' may leak";
weaken_deeply($href);
ok !may_leak($href), "'$href' may not leak";

SKIP:{
    skip 'PadWalker not installed', 5 unless Data::Decycle::HAS_PADWALKER;
    my $cref;
    $cref = sub{ $_[0] <= 1 ? 1 : $_[0] * $cref->($_[0] - 1) };
    ok may_leak($cref), "'$cref' may leak";
    weaken_deeply($cref);
    ok may_leak($cref), "'$cref' may STILL leak";
    is $cref->(10), 3628800, "($cref)->(10) is 3628800";

    $cref = sub{ shift };
    ok !may_leak($cref), "'$cref' may not leak";
    $cref = recsub { $_[0] <= 1 ? 1 : $_[0] * $CALLEE->($_[0]-1) };