File Coverage

blib/lib/POE/Resource/Aliases.pm
Criterion Covered Total %
statement 40 46 86.9
branch 11 12 91.6
condition n/a
subroutine 12 12 100.0
pod n/a
total 63 70 90.0


line stmt bran cond sub pod time code
1             # Manage the POE::Kernel data structures necessary to keep track of
2             # session aliases.
3              
4             package POE::Resource::Aliases;
5              
6 176     176   710 use vars qw($VERSION);
  176         248  
  176         8794  
7             $VERSION = '1.366'; # NOTE - Should be #.### (three decimal places)
8              
9             # These methods are folded into POE::Kernel;
10             package POE::Kernel;
11              
12 176     176   752 use strict;
  176         233  
  176         77026  
13              
14             ### The table of session aliases, and the sessions they refer to.
15              
16             my %kr_aliases;
17             # ( $alias => $session_ref,
18             # ...,
19             # );
20              
21             my %kr_ses_to_alias;
22             # ( $session_id =>
23             # { $alias => $session_ref,
24             # ...,
25             # },
26             # ...,
27             # );
28              
29             sub _data_alias_initialize {
30 174     174   585 $poe_kernel->[KR_ALIASES] = \%kr_aliases;
31             }
32              
33             sub _data_alias_relocate_kernel_id {
34 4     4   8 my ($self, $old_id, $new_id) = @_;
35 4 50       22 return unless exists $kr_ses_to_alias{$old_id};
36 0         0 $kr_ses_to_alias{$new_id} = delete $kr_ses_to_alias{$old_id};
37             }
38              
39             ### End-run leak checking. Returns true if finalization was ok, or
40             ### false if it failed.
41              
42             sub _data_alias_finalize {
43 191     191   697 my $finalized_ok = 1;
44 191         814 while (my ($alias, $ses) = each(%kr_aliases)) {
45 0         0 _warn "!!! Leaked alias: $alias = $ses\n";
46 0         0 $finalized_ok = 0;
47             }
48 191         1523 while (my ($ses_id, $alias_rec) = each(%kr_ses_to_alias)) {
49 0         0 my @aliases = keys(%$alias_rec);
50 0         0 _warn "!!! Leaked alias cross-reference: $ses_id (@aliases)\n";
51 0         0 $finalized_ok = 0;
52             }
53 191         376 return $finalized_ok;
54             }
55              
56             # Add an alias to a session.
57             #
58             # TODO This has a potential problem: setting the same alias twice on a
59             # session will increase the session's reference count twice. Removing
60             # the alias will only decrement it once. That potentially causes
61             # reference counts that never go away. The public interface for this
62             # function, alias_set(), does not allow this to occur. We should add
63             # a test to make sure it never does.
64             #
65             # TODO It is possible to add aliases to sessions that do not exist.
66             # The public alias_set() function prevents this from happening.
67              
68             sub _data_alias_add {
69 151     151   2027 my ($self, $session, $alias) = @_;
70             # _warn( "Session ", $session->ID, " is alias $alias\n" );
71 151         349 $self->_data_ses_refcount_inc($session->ID);
72 151         12489 $kr_aliases{$alias} = $session;
73 151         493 $kr_ses_to_alias{$session->ID}->{$alias} = $session;
74             }
75              
76             # Remove an alias from a session.
77             #
78             # TODO Happily allows the removal of aliases from sessions that don't
79             # exist. This will cause problems with reference counting.
80              
81             sub _data_alias_remove {
82 132     132   544 my ($self, $session, $alias) = @_;
83             # _warn( "Session ", $session->ID, " was alias $alias\n" );
84 132         225 delete $kr_aliases{$alias};
85 132         399 delete $kr_ses_to_alias{$session->ID}->{$alias};
86 132         676 $self->_data_ses_refcount_dec($session->ID);
87             }
88              
89             ### Clear all the aliases from a session.
90              
91             sub _data_alias_clear_session {
92 791     791   1271 my ($self, $sid) = @_;
93 791 100       2293 return unless exists $kr_ses_to_alias{$sid}; # avoid autoviv
94 127         184 while (my ($alias, $ses_ref) = each %{$kr_ses_to_alias{$sid}}) {
  198         853  
95 71         205 $self->_data_alias_remove($ses_ref, $alias);
96             }
97 127         390 delete $kr_ses_to_alias{$sid};
98             }
99              
100             ### Resolve an alias. Just an alias.
101              
102             sub _data_alias_resolve {
103 384     384   542 my ($self, $alias) = @_;
104 384 100       1093 return undef unless exists $kr_aliases{$alias};
105 226         545 return $kr_aliases{$alias};
106             }
107              
108             ### Return a list of aliases for a session.
109              
110             sub _data_alias_list {
111 8562     8562   8040 my ($self, $sid) = @_;
112 8562 100       14213 return () unless exists $kr_ses_to_alias{$sid};
113 8561         7291 return sort keys %{$kr_ses_to_alias{$sid}};
  8561         85118  
114             }
115              
116             ### Return the number of aliases for a session.
117              
118             sub _data_alias_count_ses {
119 4742     4742   5842 my ($self, $sid) = @_;
120 4742 100       17681 return 0 unless exists $kr_ses_to_alias{$sid};
121 1486         1553 return scalar keys %{$kr_ses_to_alias{$sid}};
  1486         5140  
122             }
123              
124             ### Return a session's ID in a form suitable for logging.
125              
126             sub _data_alias_loggable {
127 37251     37251   41149 my ($self, $sid) = @_;
128 37251 100       234425 "session $sid" . (
129             (exists $kr_ses_to_alias{$sid})
130             ? ( " (" . join(", ", $self->_data_alias_list($sid)) . ")" )
131             : ""
132             );
133             }
134              
135             1;
136              
137             __END__