/usr/share/perl5/JE/Destroyer.pm is in libje-perl 0.056-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | package JE::Destroyer;
our $VERSION = '0.056';
use strict;
use warnings;
# We cannot use JE::_FieldHash, because we end up triggering bugs in weak
# references in 5.8. (JE::_FieldHash uses Tie::RefHash::Weak in 5.8.)
# (Those bugs were fixed between 5.10.1 and 5.12.4, but by which commit
# I wot not.)
#use JE::_FieldHash;
BEGIN {
require constant;
# unsafe_helem means that $h{$foo} will stringify $foo.
# Hash::Util::FieldHash doesn’t stringify a ref key.
import constant unsafe_helem =>
not my $hufh = eval { require Hash::Util::FieldHash };
if ($hufh) {
import Hash::Util::FieldHash 'fieldhash';
}
else { *fieldhash = sub {$_[0]} }
}
use Scalar'Util qw 'refaddr weaken';
fieldhash my %js_envs;
$JE::Destroyer = 1;
sub register {
my $global = $_[0]->global;
my $globaddr = refaddr $global;
if ($globaddr == refaddr $_[0]) { return }
($js_envs{unsafe_helem ? $globaddr : $global} ||= &fieldhash({}))
->{unsafe_helem ? refaddr $_[0] : $_[0]} = \(my $entry = $_[0]);
weaken $entry;
return # nothing;
}
sub destroy {
exists $js_envs{$_[0]} or return;
# We can’t just iterate over the values, bceause $$_->destroy might
# actually free some of the things we are iterating over. So put them in
# an array first.
my @objs = values %{ $js_envs{$_[0]} };
# And still, since the values are themselves weak references to the
# objects, we have to check for definition.
defined $$_ and $$_->destroy for @objs;
delete $js_envs{$_[0]};
$_[0]->destroy;
return # nothing;
}
__END__
=head1 NAME
JE::Destroyer - Experimental destructor for JE
=head1 SYNOPSIS
use JE::Destroyer; # must come first
use JE;
$j = new JE;
# ... do stuff ...
JE::Destroyer::destroy($j); # break circular refs
undef $j;
=head1 DESCRIPTION
This is an I<experimental> module that provides a way to destroy JE objects
without leaking memory.
Details of its interface are subject to change drastically between
releases.
See the L</SYNOPSIS> above for usage.
=head1 SEE ALSO
L<JE>
|