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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
package DNS::LDNS::GC;
use strict;
use warnings;
our $VERSION = '0.52';
my %ref_count;
my %owned_by;
sub own {
my ($obj, $owner) = @_;
# print STDERR "Owning $obj -> $owner\n";
return unless (defined $obj);
if ($owned_by{$$owner}) {
# If the owner is an owned object, let obj be owned by
# the owners owner. We want to avoid recursive ownerships.
$owner = $owned_by{$$owner};
}
if (exists $owned_by{$$obj}) {
$ref_count{$$obj}++;
}
else {
$ref_count{$$obj} = 1;
$owned_by{$$obj} = $owner;
}
return $obj;
}
# Return true if the object is owned by someone
sub is_owned {
return (exists $owned_by{${$_[0]}});
}
sub owner {
return $owned_by{${$_[0]}};
}
sub disown {
return unless (defined $_[0]);
delete $owned_by{${$_[0]}};
}
my %free_method = (
'DNS::LDNS::Zone' => '_zone_deep_free',
'DNS::LDNS::RRList' => '_rrlist_deep_free',
'DNS::LDNS::RR' => '_rr_free',
'DNS::LDNS::RData' => '_rdata_deep_free',
'DNS::LDNS::DNSSecZone' => '_dnssec_zone_deep_free',
'DNS::LDNS::DNSSecName' => '_dnssec_name_deep_free',
'DNS::LDNS::Resolver' => '_resolver_deep_free',
'DNS::LDNS::Packet' => '_packet_free',
'DNS::LDNS::Key' => '_key_deep_free',
'DNS::LDNS::KeyList' => '_keylist_free',
'DNS::LDNS::DNSSecDataChain' => '_dnssec_datachain',
);
my %not_deleted_by_owner = (
'DNS::LDNS::DNSSecTrustChain' => 1,
);
sub free {
my $obj = shift;
# print STDERR "Freeing $obj\n";
if (exists $ref_count{$$obj}) {
# print STDERR "Derefing $obj\n";
$ref_count{$$obj}--;
return if ($ref_count{$$obj} > 0);
}
# print STDERR "Deleting $obj\n";
delete $ref_count{$$obj};
if (exists $owned_by{$$obj}) {
delete $owned_by{$$obj};
return unless ($not_deleted_by_owner{ref $obj});
}
my $class = ref $obj;
my $free = $free_method{ref $obj};
die "Internal error: No freeing method for $obj (".ref $obj.")"
unless ($free);
no strict;
&$free($obj);
}
1;
__END__
=head1 NAME
DNS::LDNS::GC - Garbage collector, used internally by the DNS::LDNS modules
=head1 SYNOPSIS
Garbage collector class for DNS::LDNS objects.
=head1 SEE ALSO
http://www.nlnetlabs.nl/projects/ldns
=head1 AUTHOR
Erik Pihl Ostlyngen, E<lt>erik.ostlyngen@uninett.noE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2013 by UNINETT Norid AS
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.14.2 or,
at your option, any later version of Perl 5 you may have available.
=cut
|
