The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
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;