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 / Events.pm < prev    next >
Encoding:
Perl POD Document  |  2004-01-21  |  7.1 KB  |  282 lines
  1. # $Id: Events.pm,v 1.10 2004/01/21 17:27:01 rcaputo Exp $
  2.  
  3. # Data and accessors to manage POE's events.
  4.  
  5. package POE::Resources::Events;
  6.  
  7. use vars qw($VERSION);
  8. $VERSION = do {my@r=(q$Revision: 1.10 $=~/\d+/g);sprintf"%d."."%04d"x$#r,@r};
  9.  
  10. # These methods are folded into POE::Kernel;
  11. package POE::Kernel;
  12.  
  13. use strict;
  14.  
  15. # A local copy of the queue so we can manipulate it directly.
  16. my $kr_queue;
  17.  
  18. my %event_count;
  19. #  ( $session => $count,
  20. #    ...,
  21. #  );
  22.  
  23. my %post_count;
  24. #  ( $session => $count,
  25. #    ...,
  26. #  );
  27.  
  28. ### Begin-run initialization.
  29.  
  30. sub _data_ev_initialize {
  31.   my ($self, $queue) = @_;
  32.   $kr_queue = $queue;
  33. }
  34.  
  35. ### End-run leak checking.
  36.  
  37. sub _data_ev_finalize {
  38.   my $finalized_ok = 1;
  39.   while (my ($ses, $cnt) = each(%event_count)) {
  40.     $finalized_ok = 0;
  41.     _warn("!!! Leaked event-to count: $ses = $cnt\n");
  42.   }
  43.  
  44.   while (my ($ses, $cnt) = each(%post_count)) {
  45.     $finalized_ok = 0;
  46.     _warn("!!! Leaked event-from count: $ses = $cnt\n");
  47.   }
  48.   return $finalized_ok;
  49. }
  50.  
  51. ### Enqueue an event.
  52.  
  53. sub _data_ev_enqueue {
  54.   my (
  55.     $self, $session, $source_session, $event, $type, $etc, $file, $line, $time
  56.   ) = @_;
  57.  
  58.   if (ASSERT_DATA) {
  59.     unless ($self->_data_ses_exists($session)) {
  60.       _trap(
  61.         "<ev> can't enqueue event ``$event'' for nonexistent session $session\n"
  62.       );
  63.     }
  64.   }
  65.  
  66.   # This is awkward, but faster than using the fields individually.
  67.   my $event_to_enqueue = [ @_[1..7] ];
  68.  
  69.   my $old_head_priority = $kr_queue->get_next_priority();
  70.   my $new_id = $kr_queue->enqueue($time, $event_to_enqueue);
  71.  
  72.   if (TRACE_EVENTS) {
  73.     _warn(
  74.       "<ev> enqueued event $new_id ``$event'' from ",
  75.       $self->_data_alias_loggable($source_session), " to ",
  76.       $self->_data_alias_loggable($session),
  77.       " at $time"
  78.     );
  79.   }
  80.  
  81.   if ($kr_queue->get_item_count() == 1) {
  82.     $self->loop_resume_time_watcher($time);
  83.   }
  84.   elsif ($time < $old_head_priority) {
  85.     $self->loop_reset_time_watcher($time);
  86.   }
  87.  
  88.   $self->_data_ses_refcount_inc($session);
  89.   $event_count{$session}++;
  90.  
  91.   $self->_data_ses_refcount_inc($source_session);
  92.   $post_count{$source_session}++;
  93.  
  94.   return $new_id;
  95. }
  96.  
  97. ### Remove events sent to or from a specific session.
  98.  
  99. sub _data_ev_clear_session {
  100.   my ($self, $session) = @_;
  101.  
  102.   my $my_event = sub {
  103.     ($_[0]->[EV_SESSION] == $session) || ($_[0]->[EV_SOURCE] == $session)
  104.   };
  105.  
  106.   # TODO - This is probably incorrect.  The total event count will be
  107.   # artificially inflated for events from/to the same session.  That
  108.   # is, a yield() will count twice.
  109.   my $total_event_count = (
  110.     ($event_count{$session} || 0) +
  111.     ($post_count{$session} || 0)
  112.   );
  113.  
  114.   foreach ($kr_queue->remove_items($my_event, $total_event_count)) {
  115.     $self->_data_ev_refcount_dec(@{$_->[ITEM_PAYLOAD]}[EV_SOURCE, EV_SESSION]);
  116.   }
  117.  
  118.   croak if delete $event_count{$session};
  119.   croak if delete $post_count{$session};
  120. }
  121.  
  122. # -><- Alarm maintenance functions may move out to a separate
  123. # POE::Resource module in the future.  Why?  Because alarms may
  124. # eventually be managed by something other than the event queue.
  125. # Especially if we incorporate a proper Session scheduler.  Be sure to
  126. # move the tests to a corresponding t/res/*.t file.
  127.  
  128. ### Remove a specific alarm by its name.  This is in the events
  129. ### section because alarms are currently implemented as events with
  130. ### future due times.
  131.  
  132. sub _data_ev_clear_alarm_by_name {
  133.   my ($self, $session, $alarm_name) = @_;
  134.  
  135.   my $my_alarm = sub {
  136.     return 0 unless $_[0]->[EV_TYPE] & ET_ALARM;
  137.     return 0 unless $_[0]->[EV_SESSION] == $session;
  138.     return 0 unless $_[0]->[EV_NAME] eq $alarm_name;
  139.     return 1;
  140.   };
  141.  
  142.   foreach ($kr_queue->remove_items($my_alarm)) {
  143.     $self->_data_ev_refcount_dec(@{$_->[ITEM_PAYLOAD]}[EV_SOURCE, EV_SESSION]);
  144.   }
  145. }
  146.  
  147. ### Remove a specific alarm by its ID.  This is in the events section
  148. ### because alarms are currently implemented as events with future due
  149. ### times.  -><- It's possible to remove non-alarms; is that wrong?
  150.  
  151. sub _data_ev_clear_alarm_by_id {
  152.   my ($self, $session, $alarm_id) = @_;
  153.  
  154.   my $my_alarm = sub {
  155.     $_[0]->[EV_SESSION] == $session;
  156.   };
  157.  
  158.   my ($time, $id, $event) = $kr_queue->remove_item($alarm_id, $my_alarm);
  159.   return unless defined $time;
  160.  
  161.   $self->_data_ev_refcount_dec( @$event[EV_SOURCE, EV_SESSION] );
  162.   return ($time, $event);
  163. }
  164.  
  165. ### Remove all the alarms for a session.  Whoot!
  166.  
  167. sub _data_ev_clear_alarm_by_session {
  168.   my ($self, $session) = @_;
  169.  
  170.   my $my_alarm = sub {
  171.     return 0 unless $_[0]->[EV_TYPE] & ET_ALARM;
  172.     return 0 unless $_[0]->[EV_SESSION] == $session;
  173.     return 1;
  174.   };
  175.  
  176.   my @removed;
  177.   foreach ($kr_queue->remove_items($my_alarm)) {
  178.     my ($time, $event) = @$_[ITEM_PRIORITY, ITEM_PAYLOAD];
  179.     $self->_data_ev_refcount_dec( @$event[EV_SOURCE, EV_SESSION] );
  180.     push @removed, [ $event->[EV_NAME], $time, @{$event->[EV_ARGS]} ];
  181.   }
  182.  
  183.   return @removed;
  184. }
  185.  
  186. ### Decrement a post refcount
  187.  
  188. sub _data_ev_refcount_dec {
  189.   my ($self, $source_session, $dest_session) = @_;
  190.  
  191.   if (ASSERT_DATA) {
  192.     _trap $dest_session unless exists $event_count{$dest_session};
  193.     _trap $source_session unless exists $post_count{$source_session};
  194.   }
  195.  
  196.   $self->_data_ses_refcount_dec($dest_session);
  197.   $event_count{$dest_session}--;
  198.  
  199.   $self->_data_ses_refcount_dec($source_session);
  200.   $post_count{$source_session}--;
  201. }
  202.  
  203. ### Fetch the number of pending events sent to a session.
  204.  
  205. sub _data_ev_get_count_to {
  206.   my ($self, $session) = @_;
  207.   return $event_count{$session} || 0;
  208. }
  209.  
  210. ### Fetch the number of pending events sent from a session.
  211.  
  212. sub _data_ev_get_count_from {
  213.   my ($self, $session) = @_;
  214.   return $post_count{$session} || 0;
  215. }
  216.  
  217. ### Dispatch events that are due for "now" or earlier.
  218.  
  219. sub _data_ev_dispatch_due {
  220.   my $self = shift;
  221.  
  222.   if (TRACE_EVENTS) {
  223.     foreach ($kr_queue->peek_items(sub { 1 })) {
  224.       _warn(
  225.         "<ev> time($_->[ITEM_PRIORITY]) id($_->[ITEM_ID]) ",
  226.         "event(@{$_->[ITEM_PAYLOAD]})\n"
  227.       );
  228.     }
  229.   }
  230.  
  231.   my $now = time();
  232.   while (defined(my $next_time = $kr_queue->get_next_priority())) {
  233.     last if $next_time > $now;
  234.     my ($time, $id, $event) = $kr_queue->dequeue_next();
  235.  
  236.     if (TRACE_EVENTS) {
  237.       _warn("<ev> dispatching event $id ($event->[EV_NAME])");
  238.     }
  239.  
  240.     if ($time < $now) {
  241.         $self->_data_stat_add('blocked', 1);
  242.         $self->_data_stat_add('blocked_seconds', $now - $time);
  243.     }
  244.  
  245.     $self->_data_ev_refcount_dec($event->[EV_SOURCE], $event->[EV_SESSION]);
  246.     $self->_dispatch_event(@$event, $time, $id);
  247.   }
  248. }
  249.  
  250. 1;
  251.  
  252. __END__
  253.  
  254. =head1 NAME
  255.  
  256. POE::Resources::Events - manage events for POE::Kernel
  257.  
  258. =head1 SYNOPSIS
  259.  
  260. Used internally by POE::Kernel.  Better documentation will be
  261. forthcoming.
  262.  
  263. =head1 DESCRIPTION
  264.  
  265. This module hides the complexity of managing POE's events from even
  266. POE itself.  It is used internally by POE::Kernel and has no public
  267. interface.
  268.  
  269. =head1 SEE ALSO
  270.  
  271. See L<POE::Kernel> for documentation on events.
  272.  
  273. =head1 BUGS
  274.  
  275. Probably.
  276.  
  277. =head1 AUTHORS & COPYRIGHTS
  278.  
  279. Please see L<POE> for more information about authors and contributors.
  280.  
  281. =cut
  282.