home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Aliases.pm < prev    next >
Encoding:
Perl POD Document  |  2003-11-21  |  4.1 KB  |  166 lines
  1. # $Id: Aliases.pm,v 1.10 2003/11/21 05:08:26 rcaputo Exp $
  2.  
  3. # Manage the POE::Kernel data structures necessary to keep track of
  4. # session aliases.
  5.  
  6. package POE::Resources::Aliases;
  7.  
  8. use vars qw($VERSION);
  9. $VERSION = do {my@r=(q$Revision: 1.10 $=~/\d+/g);sprintf"%d."."%04d"x$#r,@r};
  10.  
  11. # These methods are folded into POE::Kernel;
  12. package POE::Kernel;
  13.  
  14. use strict;
  15.  
  16. ### The table of session aliases, and the sessions they refer to.
  17.  
  18. my %kr_aliases;
  19. #  ( $alias => $session_ref,
  20. #    ...,
  21. #  );
  22.  
  23. my %kr_ses_to_alias;
  24. #  ( $session_ref =>
  25. #    { $alias => $placeholder_value,
  26. #      ...,
  27. #    },
  28. #    ...,
  29. #  );
  30.  
  31. sub _data_ses_initialize {
  32.   $poe_kernel->[KR_ALIASES] = \%kr_aliases;
  33. }
  34. use POE::API::ResLoader \&_data_ses_initialize;
  35.  
  36. ### End-run leak checking.  Returns true if finazilation was ok, or
  37. ### false if it failed.
  38.  
  39. sub _data_alias_finalize {
  40.   my $finalized_ok = 1;
  41.   while (my ($alias, $ses) = each(%kr_aliases)) {
  42.     _warn "!!! Leaked alias: $alias = $ses\n";
  43.     $finalized_ok = 0;
  44.   }
  45.   while (my ($ses, $alias_rec) = each(%kr_ses_to_alias)) {
  46.     my @aliases = keys(%$alias_rec);
  47.     _warn "!!! Leaked alias cross-reference: $ses (@aliases)\n";
  48.     $finalized_ok = 0;
  49.   }
  50.   return $finalized_ok;
  51. }
  52.  
  53. # Add an alias to a session.
  54. #
  55. # -><- This has a potential problem: setting the same alias twice on a
  56. # session will increase the session's reference count twice.  Removing
  57. # the alias will only decrement it once.  That potentially causes
  58. # reference counts that never go away.  The public interface for this
  59. # function, alias_set(), does not allow this to occur.  We should add
  60. # a test to make sure it never does.
  61. #
  62. # -><- It is possible to add aliases to sessions that do not exist.
  63. # The public alias_set() function prevents this from happening.
  64.  
  65. sub _data_alias_add {
  66.   my ($self, $session, $alias) = @_;
  67.   $self->_data_ses_refcount_inc($session);
  68.   $kr_aliases{$alias} = $session;
  69.   $kr_ses_to_alias{$session}->{$alias} = 1;
  70. }
  71.  
  72. # Remove an alias from a session.
  73. #
  74. # -><- Happily allows the removal of aliases from sessions that don't
  75. # exist.  This will cause problems with reference counting.
  76.  
  77. sub _data_alias_remove {
  78.   my ($self, $session, $alias) = @_;
  79.   delete $kr_aliases{$alias};
  80.   delete $kr_ses_to_alias{$session}->{$alias};
  81.   $self->_data_ses_refcount_dec($session);
  82. }
  83.  
  84. ### Clear all the aliases from a session.
  85.  
  86. sub _data_alias_clear_session {
  87.   my ($self, $session) = @_;
  88.   return unless exists $kr_ses_to_alias{$session}; # avoid autoviv
  89.   foreach (keys %{$kr_ses_to_alias{$session}}) {
  90.     $self->_data_alias_remove($session, $_);
  91.   }
  92.   delete $kr_ses_to_alias{$session};
  93. }
  94.  
  95. ### Resolve an alias.  Just an alias.
  96.  
  97. sub _data_alias_resolve {
  98.   my ($self, $alias) = @_;
  99.   return undef unless exists $kr_aliases{$alias};
  100.   return $kr_aliases{$alias};
  101. }
  102.  
  103. ### Return a list of aliases for a session.
  104.  
  105. sub _data_alias_list {
  106.   my ($self, $session) = @_;
  107.   return () unless exists $kr_ses_to_alias{$session};
  108.   return sort keys %{$kr_ses_to_alias{$session}};
  109. }
  110.  
  111. ### Return the number of aliases for a session.
  112.  
  113. sub _data_alias_count_ses {
  114.   my ($self, $session) = @_;
  115.   return 0 unless exists $kr_ses_to_alias{$session};
  116.   return scalar keys %{$kr_ses_to_alias{$session}};
  117. }
  118.  
  119. ### Return a session's ID in a form suitable for logging.
  120.  
  121. sub _data_alias_loggable {
  122.   my ($self, $session) = @_;
  123.  
  124.   if (ASSERT_DATA) {
  125.     _trap unless ref($session);
  126.   }
  127.  
  128.   "session " . $session->ID . " (" .
  129.     ( (exists $kr_ses_to_alias{$session})
  130.       ? join(", ", $self->_data_alias_list($session))
  131.       : $session
  132.     ) . ")"
  133. }
  134.  
  135. 1;
  136.  
  137. __END__
  138.  
  139. =head1 NAME
  140.  
  141. POE::Resources::Aliases - manage session aliases for POE::Kernel
  142.  
  143. =head1 SYNOPSIS
  144.  
  145. Used internally by POE::Kernel.  Better documentation will be
  146. forthcoming.
  147.  
  148. =head1 DESCRIPTION
  149.  
  150. This module manages session aliases for POE::Kernel.  It is used
  151. internally by POE::Kernel and has no public interface.
  152.  
  153. =head1 SEE ALSO
  154.  
  155. See L<POE::Kernel> for documentation on session aliases.
  156.  
  157. =head1 BUGS
  158.  
  159. Probably.
  160.  
  161. =head1 AUTHORS & COPYRIGHTS
  162.  
  163. Please see L<POE> for more information about authors and contributors.
  164.  
  165. =cut
  166.