File Coverage

blib/lib/POE/Resource/Extrefs.pm
Criterion Covered Total %
statement 37 45 82.2
branch 10 12 83.3
condition n/a
subroutine 9 10 90.0
pod n/a
total 56 67 83.5


line stmt bran cond sub pod time code
1             # The data necessary to manage tagged extra/external reference counts
2             # on sessions, and the accessors to get at them sanely from other
3             # files.
4              
5             package POE::Resource::Extrefs;
6              
7 176     176   727 use vars qw($VERSION);
  176         241  
  176         9201  
8             $VERSION = '1.366'; # NOTE - Should be #.### (three decimal places)
9              
10             # These methods are folded into POE::Kernel;
11             package POE::Kernel;
12              
13 176     176   776 use strict;
  176         402  
  176         98603  
14              
15             ### The count of all extra references used in the system.
16              
17             my %kr_extra_refs;
18             # ( $session_id =>
19             # { $tag => $count,
20             # ...,
21             # },
22             # ...,
23             # );
24              
25             sub _data_extref_relocate_kernel_id {
26 0     0   0 my ($self, $old_id, $new_id) = @_;
27 0 0       0 return unless exists $kr_extra_refs{$old_id};
28 0         0 $kr_extra_refs{$new_id} = delete $kr_extra_refs{$old_id};
29             }
30              
31             ### End-run leak checking.
32              
33             sub _data_extref_finalize {
34 191     191   288 my $finalized_ok = 1;
35 191         670 foreach my $session_id (keys %kr_extra_refs) {
36 0         0 $finalized_ok = 0;
37 0         0 _warn "!!! Leaked extref: $session_id\n";
38 0         0 foreach my $tag (keys %{$kr_extra_refs{$session_id}}) {
  0         0  
39 0         0 _warn "!!!\t`$tag' = $kr_extra_refs{$session_id}->{$tag}\n";
40             }
41             }
42 191         404 return $finalized_ok;
43             }
44              
45             # Increment a session's tagged reference count. If this is the first
46             # time the tag is used in the session, then increment the session's
47             # reference count as well. Returns the tag's new reference count.
48             #
49             # TODO Allows incrementing reference counts on sessions that don't
50             # exist, but the public interface catches that.
51             #
52             # TODO Need to track extref ownership for signal-based session
53             # termination. One problem seen is that signals terminate sessions
54             # out of order. Owners think extra refcounts exist for sessions that
55             # are no longer around. Ownership trees give us a few benefits: We
56             # can make sure sessions destruct in a cleaner order. We can detect
57             # refcount loops and possibly prevent that.
58              
59             sub _data_extref_inc {
60 109     109   196 my ($self, $sid, $tag) = @_;
61 109         822 my $refcount = ++$kr_extra_refs{$sid}->{$tag};
62              
63             # TODO We could probably get away with only incrementing the
64             # session's master refcount once, as long as any extra refcount is
65             # positive. Then the session reference count would be a flag
66             # instead of a counter.
67 109 100       491 $self->_data_ses_refcount_inc($sid) if $refcount == 1;
68              
69 109         2802 if (TRACE_REFCNT) {
70             _warn(
71             " incremented extref ``$tag'' (now $refcount) for ",
72             $self->_data_alias_loggable($sid)
73             );
74             }
75              
76 109         326 return $refcount;
77             }
78              
79             # Decrement a session's tagged reference count, removing it outright
80             # if the count reaches zero. Return the new reference count or undef
81             # if the tag doesn't exist.
82             #
83             # TODO Allows negative reference counts, and the resulting hilarity.
84             # Hopefully the public interface won't allow it.
85              
86             sub _data_extref_dec {
87 138     106   435 my ($self, $sid, $tag) = @_;
88              
89 106         126 if (ASSERT_DATA) {
90             # Prevents autoviv.
91             _trap("
decrementing extref for session without any")
92             unless exists $kr_extra_refs{$sid};
93              
94             unless (exists $kr_extra_refs{$sid}->{$tag}) {
95             _trap(
96             "
decrementing extref for nonexistent tag ``$tag'' in ",
97             $self->_data_alias_loggable($sid)
98             );
99             }
100             }
101              
102 106         306 my $refcount = --$kr_extra_refs{$sid}->{$tag};
103              
104 105         349 if (TRACE_REFCNT) {
105             _warn(
106             " decremented extref ``$tag'' (now $refcount) for ",
107             $self->_data_alias_loggable($sid)
108             );
109             }
110              
111 2 100       9 $self->_data_extref_remove($sid, $tag) unless $refcount;
112 104         224 return $refcount;
113             }
114              
115             ### Remove an extra reference from a session, regardless of its count.
116              
117             sub _data_extref_remove {
118 204     101   309 my ($self, $sid, $tag) = @_;
119              
120 204         670 if (ASSERT_DATA) {
121             # Prevents autoviv.
122             _trap("
removing extref from session without any")
123             unless exists $kr_extra_refs{$sid};
124             unless (exists $kr_extra_refs{$sid}->{$tag}) {
125             _trap(
126             "
removing extref for nonexistent tag ``$tag'' in ",
127             $self->_data_alias_loggable($sid)
128             );
129             }
130             }
131              
132 204         7533 delete $kr_extra_refs{$sid}->{$tag};
133 127 100       446 delete $kr_extra_refs{$sid} unless scalar keys %{$kr_extra_refs{$sid}};
  2         10  
134 99         270 $self->_data_ses_refcount_dec($sid);
135             }
136              
137             ### Clear all the extra references from a session.
138              
139             sub _data_extref_clear_session {
140 889     791   1454 my ($self, $sid) = @_;
141              
142             # TODO - Should there be a _trap here if the session doesn't exist?
143              
144 889 100       2684 return unless exists $kr_extra_refs{$sid}; # avoid autoviv
145 99         331 foreach (keys %{$kr_extra_refs{$sid}}) {
  1         4  
146 2         5 $self->_data_extref_remove($sid, $_);
147             }
148              
149 1         4 if (ASSERT_DATA) {
150             if (exists $kr_extra_refs{$sid}) {
151             _trap(
152             "
extref clear did not remove session ",
153             $self->_data_alias_loggable($sid)
154             );
155             }
156             }
157             }
158              
159             # Fetch the number of sessions with extra references held in the
160             # entire system.
161              
162             sub _data_extref_count {
163 1393     1392   6897 return scalar keys %kr_extra_refs;
164             }
165              
166             # Fetch whether a session has extra references.
167              
168             sub _data_extref_count_ses {
169 4745     4745   5462 my ($self, $sid) = @_;
170 4745 100       20488 return 0 unless exists $kr_extra_refs{$sid};
171 70         93 return scalar keys %{$kr_extra_refs{$sid}};
  70         333  
172             }
173              
174             1;
175              
176             __END__