This is a second patch, this has around 0.5% overhead when no hooks are registred.
attached is also a program called poeprofiler.pl just require it and it will show a
profiler analysis after your program is finished
--- oldpoe/poe/POE/Kernel.pm Wed Jun 13 17:46:19 2001
+++ poe/POE/Kernel.pm Sun Jul 8 22:11:33 2001
@@ -9,6 +9,14 @@
use vars qw( $poe_kernel $poe_main_window );
+use vars qw($hook_session $hook_source_session $hook_local_state $hook_etc $hook_file
+$hook_line $hook_dispatch $hook_return);
+use vars qw(%pre_dispatch_hooks %post_dispatch_hooks %pre_hooks %post_hooks $hook_id
+$hooks @hooks);
+
+($hook_id, $hooks) = (1,0);
+$pre_dispatch_hooks{""} = {};
+$post_dispatch_hooks{""} = {};
+
+
#------------------------------------------------------------------------------
sub import {
@@ -794,6 +802,9 @@
0, # SS_ALCOUNT
];
+ $pre_dispatch_hooks{$session} = {};
+ $post_dispatch_hooks{$session} = {};
+
# For the ID to session reference lookup.
$kr_session_ids{$kr_id_index} = $session;
@@ -918,9 +929,41 @@
my $hold_active_session = $kr_active_session;
$kr_active_session = $session;
+
+
+
# Dispatch the event, at long last.
- my $return =
- $session->_invoke_state($source_session, $local_state, $etc, $file, $line);
+
+ my $return;
+
+
+ if($hooks) {
+
+ ($hook_session, $hook_source_session,$hook_local_state, $hook_etc, $hook_file,
+$hook_line, $hook_dispatch) =
+ ( $session, $source_session, $local_state, $etc, $file,
+ $line, 0);
+
+
+ for(values %{$pre_dispatch_hooks{""}->{""}}, values
+%{$pre_dispatch_hooks{""}->{$local_state}},
+ values %{$pre_dispatch_hooks{"$session"}->{""}}, values
+%{$pre_dispatch_hooks{"$session"}->{$local_state}}) {
+ $hook_dispatch = 1 if($hook_return = $_->());
+ }
+
+ unless($hook_dispatch) {
+ $hook_return = $return = $session->_invoke_state($source_session, $local_state,
+$etc, $file, $line);
+ }
+
+ for(values %{$post_dispatch_hooks{""}->{""}}, values
+%{$post_dispatch_hooks{""}->{$local_state}},
+ values %{$post_dispatch_hooks{"$session"}->{""}}, values
+%{$post_dispatch_hooks{"$session"}->{$local_state}}) {
+ $hook_dispatch = 1 if($hook_return = $_->());
+ }
+
+
+ ($hook_session, $hook_source_session, $hook_local_state, $hook_etc, $hook_file,
+$hook_line, $hook_return, $hook_dispatch) =
+ (undef, undef, undef, undef, undef, undef, undef, undef);
+
+ } else {
+ $return = $session->_invoke_state($source_session, $local_state, $etc, $file,
+$line);
+ }
# Stringify the state's return value if it belongs in the POE
# namespace. $return's scope exists beyond the post-dispatch
@@ -1002,6 +1045,10 @@
delete $kr_sessions{$session}->[SS_CHILDREN]->{$_};
{% ses_refcount_dec $session %}
+
+ delete($pre_dispatch_hooks{$session});
+ delete($post_dispatch_hooks{$session});
+
}
# Free any signals that the departing session allocated.
@@ -2890,6 +2937,80 @@
return ESRCH;
}
+#==============================================================================
+# HOOKS
+#==============================================================================
+
+my %hooks = ( dispatch_state => 1);
+
+sub hook_set {
+ my ($self, $when, $session, $hook, $callback, $event) = @_;
+
+ if($session) {
+ croak("Session $session is not a registred session")
+unless(exists($self->[KR_SESSIONS]->{"$session"}));
+ }
+ croak("Hook $hook is not an avaible hook") unless(exists($hooks{$hook}));
+ if($when) {
+ croak("You cannot register a hook to run '$when', only 'pre' and 'post'") if($when
+ne 'post' && $when ne 'pre');
+ } else {
+ $when = 'pre';
+ }
+ carp("We need a callback") unless(ref($callback));
+
+ if($hook eq 'dispatch_state') {
+
+ if($when eq 'pre') {
+ $pre_dispatch_hooks{"$session"}->{$event}->{$callback} = $callback;
+ } else {
+ $post_dispatch_hooks{"$session"}->{$event}->{$callback} = $callback;
+ }
+ $hooks[$hook_id] = [$session,$when,$callback,$event];
+ } else {
+ if($when eq 'pre') {
+ $pre_hooks{"$session"}->{$callback} = $callback;
+ } else {
+ $post_hooks{"$session"}->{$callback} = $callback;
+ }
+ $hooks[$hook_id] = [$session,$when,$callback];
+ }
+
+
+
+ $hooks++;
+ return $hook_id++;
+}
+
+sub hook_remove {
+ my($self, $id) = @_;
+
+ my $hook = delete($hooks[$id]);
+ carp("No hook with id '$id' exists") unless(ref($hook) eq 'ARRAY');
+
+ if(@$hook == 3) {
+ if($hook->[1] eq 'pre') {
+ delete($pre_hooks{$hook->[0]}->{$hook->[2]});
+ delete($pre_hooks{$hook->[0]}) unless(@{$pre_hooks{$hook->[0]}});
+ } else {
+ delete($post_hooks{$hook->[0]}->{$hook->[2]});
+ delete($post_hooks{$hook->[0]}) unless(@{$post_hooks{$hook->[0]}});
+ }
+ } else {
+ if($hook->[1] eq 'pre') {
+ delete($pre_dispatch_hooks{$hook->[0]}->{$hook->[3]}->{$hook->[2]});
+ delete($pre_dispatch_hooks{$hook->[0]}->{$hook->[3]})
+unless(@{$pre_dispatch_hooks{$hook->[0]}->{$hook->[3]}});
+ delete($pre_dispatch_hooks{$hook->[0]})
+unless(@{$pre_dispatch_hooks{$hook->[0]}});
+ } else {
+ delete($post_dispatch_hooks{$hook->[0]}->{$hook->[3]}->{$hook->[2]});
+ delete($post_dispatch_hooks{$hook->[0]}->{$hook->[3]})
+unless(@{$post_dispatch_hooks{$hook->[0]}->{$hook->[3]}});
+ delete($post_dispatch_hooks{$hook->[0]})
+unless(@{$post_dispatch_hooks{$hook->[0]}});
+ }
+
+ }
+ $hooks--;
+}
+
+
+
###############################################################################
# Bootstrap the kernel. This is inherited from a time when multiple
# kernels could be present in the same Perl process.
@@ -2897,6 +3018,7 @@
POE::Kernel->new();
###############################################################################
+
1;
__END__
@@ -3080,6 +3202,12 @@
# kernel if called outside any session.
$session = $kernel->get_active_session();
+Kernel hooks:
+
+ # Kernel hooks lets you set hooks at varius points in the kernel
+ $hookid = $kernel->hook_set($when, $session, $hook, $callback, $event);
+ $kernel->hook_remeve($hookid);
+
Exported symbols:
# A reference to the global POE::Kernel instance.
@@ -4096,6 +4224,99 @@
tediously need to include C<SESSION> with every call.
=back
+
+=head2 Kernel Hooks
+
+Kernel Hooks provide a way to add in hooks at various points in the
+kernels exeuction. The following two functions control thiss behaviour
+
+=over 2
+
+=item my $hook_id = $poe_kernel->hook_set($when, $session $hook, $callback, $event);
+
+This sets a hook.
+
+=over 2
+
+=item $when
+
+Should be pre or post depending on when you want the hook executed
+
+=item $session
+
+The session you want to watch, empty for all sessions
+
+=item $hook
+
+What kind of hook, (hooks listed below)
+
+=item $callback
+
+A CODEREF to a subroutine
+
+=item $event
+
+The name of the state being called, only usefull for dispatch_state hook
+
+=back
+
+=item my $poe_kernel->hook_remove($hook_id);
+
+This removes the hook with the corresonding id
+
+=item Hooks
+
+=over 2
+
+=item dispatch_state
+
+This hook is called just before and just after dispatch_state,
+if a pre hook returns true, it is assumed it has taken care of the
+dispatch and POEs normal dispatch is ignored! If you do not want this,
+make sure all dispatches end with return 0;
+
+dispatch_state exposes quite a lot of variables, they are not exported and
+should be referenced as $POE::Kernel::variable
+
+=over 2
+
+=item $hook_session
+
+This is the session being invoked
+
+=item $hook_source_session
+
+This is the source of the event
+
+=item $hook_local_state
+
+This is the state being invoked
+
+=item $hook_etc
+
+This is an arrayref of arguments
+
+=item $hook_file
+
+What file made the event
+
+=item $hook_line
+
+And corresponding line!
+
+=item $hook_dispatch
+
+This is true if a hook has already dispatched the event
+
+=item $hook_return
+
+The return value from the dispatch
+
+=back
+
+=back
+
+
=head1 Using POE with Other Event Loops
--- oldpoe/poe/POE/Kernel.pm Wed Jun 13 17:46:19 2001
+++ poe/POE/Kernel.pm Sun Jul 8 22:11:33 2001
@@ -9,6 +9,14 @@
use vars qw( $poe_kernel $poe_main_window );
+use vars qw($hook_session $hook_source_session $hook_local_state $hook_etc $hook_file
+$hook_line $hook_dispatch $hook_return);
+use vars qw(%pre_dispatch_hooks %post_dispatch_hooks %pre_hooks %post_hooks $hook_id
+$hooks @hooks);
+
+($hook_id, $hooks) = (1,0);
+$pre_dispatch_hooks{""} = {};
+$post_dispatch_hooks{""} = {};
+
+
#------------------------------------------------------------------------------
sub import {
@@ -794,6 +802,9 @@
0, # SS_ALCOUNT
];
+ $pre_dispatch_hooks{$session} = {};
+ $post_dispatch_hooks{$session} = {};
+
# For the ID to session reference lookup.
$kr_session_ids{$kr_id_index} = $session;
@@ -918,9 +929,41 @@
my $hold_active_session = $kr_active_session;
$kr_active_session = $session;
+
+
+
# Dispatch the event, at long last.
- my $return =
- $session->_invoke_state($source_session, $local_state, $etc, $file, $line);
+
+ my $return;
+
+
+ if($hooks) {
+
+ ($hook_session, $hook_source_session,$hook_local_state, $hook_etc, $hook_file,
+$hook_line, $hook_dispatch) =
+ ( $session, $source_session, $local_state, $etc,
+$file, $line, 0);
+
+
+ for(values %{$pre_dispatch_hooks{""}->{""}}, values
+%{$pre_dispatch_hooks{""}->{$local_state}},
+ values %{$pre_dispatch_hooks{"$session"}->{""}}, values
+%{$pre_dispatch_hooks{"$session"}->{$local_state}}) {
+ $hook_dispatch = 1 if($hook_return = $_->());
+ }
+
+ unless($hook_dispatch) {
+ $hook_return = $return = $session->_invoke_state($source_session,
+$local_state, $etc, $file, $line);
+ }
+
+ for(values %{$post_dispatch_hooks{""}->{""}}, values
+%{$post_dispatch_hooks{""}->{$local_state}},
+ values %{$post_dispatch_hooks{"$session"}->{""}}, values
+%{$post_dispatch_hooks{"$session"}->{$local_state}}) {
+ $hook_dispatch = 1 if($hook_return = $_->());
+ }
+
+
+ ($hook_session, $hook_source_session, $hook_local_state, $hook_etc, $hook_file,
+$hook_line, $hook_return, $hook_dispatch) =
+ (undef, undef, undef, undef, undef, undef, undef, undef);
+
+ } else {
+ $return = $session->_invoke_state($source_session, $local_state, $etc, $file,
+$line);
+ }
# Stringify the state's return value if it belongs in the POE
# namespace. $return's scope exists beyond the post-dispatch
@@ -1002,6 +1045,10 @@
delete $kr_sessions{$session}->[SS_CHILDREN]->{$_};
{% ses_refcount_dec $session %}
+
+ delete($pre_dispatch_hooks{$session});
+ delete($post_dispatch_hooks{$session});
+
}
# Free any signals that the departing session allocated.
@@ -2890,6 +2937,80 @@
return ESRCH;
}
+#==============================================================================
+# HOOKS
+#==============================================================================
+
+my %hooks = ( dispatch_state => 1);
+
+sub hook_set {
+ my ($self, $when, $session, $hook, $callback, $event) = @_;
+
+ if($session) {
+ croak("Session $session is not a registred session")
+unless(exists($self->[KR_SESSIONS]->{"$session"}));
+ }
+ croak("Hook $hook is not an avaible hook") unless(exists($hooks{$hook}));
+ if($when) {
+ croak("You cannot register a hook to run '$when', only 'pre' and 'post'")
+if($when ne 'post' && $when ne 'pre');
+ } else {
+ $when = 'pre';
+ }
+ carp("We need a callback") unless(ref($callback));
+
+ if($hook eq 'dispatch_state') {
+
+ if($when eq 'pre') {
+ $pre_dispatch_hooks{"$session"}->{$event}->{$callback} = $callback;
+ } else {
+ $post_dispatch_hooks{"$session"}->{$event}->{$callback} = $callback;
+ }
+ $hooks[$hook_id] = [$session,$when,$callback,$event];
+ } else {
+ if($when eq 'pre') {
+ $pre_hooks{"$session"}->{$callback} = $callback;
+ } else {
+ $post_hooks{"$session"}->{$callback} = $callback;
+ }
+ $hooks[$hook_id] = [$session,$when,$callback];
+ }
+
+
+
+ $hooks++;
+ return $hook_id++;
+}
+
+sub hook_remove {
+ my($self, $id) = @_;
+
+ my $hook = delete($hooks[$id]);
+ carp("No hook with id '$id' exists") unless(ref($hook) eq 'ARRAY');
+
+ if(@$hook == 3) {
+ if($hook->[1] eq 'pre') {
+ delete($pre_hooks{$hook->[0]}->{$hook->[2]});
+ delete($pre_hooks{$hook->[0]}) unless(@{$pre_hooks{$hook->[0]}});
+ } else {
+ delete($post_hooks{$hook->[0]}->{$hook->[2]});
+ delete($post_hooks{$hook->[0]}) unless(@{$post_hooks{$hook->[0]}});
+ }
+ } else {
+ if($hook->[1] eq 'pre') {
+ delete($pre_dispatch_hooks{$hook->[0]}->{$hook->[3]}->{$hook->[2]});
+ delete($pre_dispatch_hooks{$hook->[0]}->{$hook->[3]})
+unless(@{$pre_dispatch_hooks{$hook->[0]}->{$hook->[3]}});
+ delete($pre_dispatch_hooks{$hook->[0]})
+unless(@{$pre_dispatch_hooks{$hook->[0]}});
+ } else {
+ delete($post_dispatch_hooks{$hook->[0]}->{$hook->[3]}->{$hook->[2]});
+ delete($post_dispatch_hooks{$hook->[0]}->{$hook->[3]})
+unless(@{$post_dispatch_hooks{$hook->[0]}->{$hook->[3]}});
+ delete($post_dispatch_hooks{$hook->[0]})
+unless(@{$post_dispatch_hooks{$hook->[0]}});
+ }
+
+ }
+ $hooks--;
+}
+
+
+
###############################################################################
# Bootstrap the kernel. This is inherited from a time when multiple
# kernels could be present in the same Perl process.
@@ -2897,6 +3018,7 @@
POE::Kernel->new();
###############################################################################
+
1;
__END__
@@ -3080,6 +3202,12 @@
# kernel if called outside any session.
$session = $kernel->get_active_session();
+Kernel hooks:
+
+ # Kernel hooks lets you set hooks at varius points in the kernel
+ $hookid = $kernel->hook_set($when, $session, $hook, $callback, $event);
+ $kernel->hook_remeve($hookid);
+
Exported symbols:
# A reference to the global POE::Kernel instance.
@@ -4096,6 +4224,99 @@
tediously need to include C<SESSION> with every call.
=back
+
+=head2 Kernel Hooks
+
+Kernel Hooks provide a way to add in hooks at various points in the
+kernels exeuction. The following two functions control thiss behaviour
+
+=over 2
+
+=item my $hook_id = $poe_kernel->hook_set($when, $session $hook, $callback, $event);
+
+This sets a hook.
+
+=over 2
+
+=item $when
+
+Should be pre or post depending on when you want the hook executed
+
+=item $session
+
+The session you want to watch, empty for all sessions
+
+=item $hook
+
+What kind of hook, (hooks listed below)
+
+=item $callback
+
+A CODEREF to a subroutine
+
+=item $event
+
+The name of the state being called, only usefull for dispatch_state hook
+
+=back
+
+=item my $poe_kernel->hook_remove($hook_id);
+
+This removes the hook with the corresonding id
+
+=item Hooks
+
+=over 2
+
+=item dispatch_state
+
+This hook is called just before and just after dispatch_state,
+if a pre hook returns true, it is assumed it has taken care of the
+dispatch and POEs normal dispatch is ignored! If you do not want this,
+make sure all dispatches end with return 0;
+
+dispatch_state exposes quite a lot of variables, they are not exported and
+should be referenced as $POE::Kernel::variable
+
+=over 2
+
+=item $hook_session
+
+This is the session being invoked
+
+=item $hook_source_session
+
+This is the source of the event
+
+=item $hook_local_state
+
+This is the state being invoked
+
+=item $hook_etc
+
+This is an arrayref of arguments
+
+=item $hook_file
+
+What file made the event
+
+=item $hook_line
+
+And corresponding line!
+
+=item $hook_dispatch
+
+This is true if a hook has already dispatched the event
+
+=item $hook_return
+
+The return value from the dispatch
+
+=back
+
+=back
+
+
=head1 Using POE with Other Event Loops
poeprofiler.pl
