package POE::Component::IKC::LocalKernel; ############################################################ # $Id: LocalKernel.pm 801 2011-08-26 15:14:24Z fil $ # Copyright 1999-2011 Philip Gwyn. All rights reserved. # This program is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. # # Contributed portions of IKC may be copyright by their respective # contributors. use strict; use POE::Session; use POE::Component::IKC::Responder; sub DEBUG () { 0 } #---------------------------------------------------- sub spawn { my $package=shift; # my %params=@_; POE::Component::IKC::Responder->spawn(); POE::Session->create( package_states=>[ $package=>[qw(_start _default shutdown send sig_INT _stop)], ], # heap=>{%params}, ); } #---------------------------------------------------- sub _start { my($kernel, $heap, $session)=@_[KERNEL, HEAP, SESSION]; $kernel->sig(INT=>'sig_INT'); $kernel->alias_set('-- Local Kernel IKC Channel --'); $heap->{ref}=1; } #---------------------------------------------------- # sub _default { my($event)=$_[STATE]; DEBUG && warn "Unknown event $event posted to IKC::LocalKernel\n" if $event !~ /^_/; return; } #---------------------------------------------------- sub _stop { # my($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; DEBUG && warn "$$: Local kernel _stop\n"; } #---------------------------------------------------- sub shutdown { my($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; DEBUG && warn "$$: Local kernel channel will shutdown.\n"; return unless $heap->{ref}; delete $heap->{ref}; $kernel->alias_remove('-- Local Kernel IKC Channel --'); } #---------------------------------------------------- sub send { my($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0]; DEBUG && warn "$$: Sending data...\n"; $request->{rsvp}->{kernel}||=$kernel->ID if ref($request) and $request->{rsvp}; DEBUG && warn "$$: Recieved data...\n"; $request->{errors_to}={ kernel=>$kernel->ID, session=>'IKC', state=>'remote_error', }; $request->{call}->{kernel}||=$heap->{kernel_name}; $kernel->call('IKC', 'request', $request); return 1; } #---------------------------------------------------- sub sig_INT { my($kernel, $heap) = @_[KERNEL, HEAP]; DEBUG && warn "$$: sig_INT\n"; $kernel->yield('shutdown'); } 1;