This is a test patch, it should work and is documented.
Dngor, apply it if you want, the slowdown for non hook users is marginal
Artur
Index: POE/Kernel.pm
===================================================================
RCS file: /cvsroot/poe/poe/POE/Kernel.pm,v
retrieving revision 1.136
diff -r1.136 Kernel.pm
11a12,19
> 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{""} = {};
>
>
796a805,807
> $pre_dispatch_hooks{$session} = {};
> $post_dispatch_hooks{$session} = {};
>
920a932,934
>
>
>
922,923c936,962
< my $return =
< $session->_invoke_state($source_session, $local_state, $etc, $file,
$line);
---
>
> my $return;
>
>
>
>
> ($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);
1004a1044,1047
>
> delete($pre_dispatch_hooks{$session});
> delete($post_dispatch_hooks{$session});
>
2892a2936,3009
>
#===========================================================================
===
> # 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--;
> }
>
>
>
2899a3017
>
3082a3201,3206
> 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);
>
4098a4223,4315
>
> =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
>
>
