[[email protected]: Re: Event.pm]

[email protected] (Joshua N Pritikin) Thu, 9 May 2002 13:29:50 +0530

Newsgroups	perl.loop
Message-ID	<[email protected]>

----- Forwarded message from Scott Beck <[email protected]> -----

From: Scott Beck <[email protected]>
To: Joshua N Pritikin <[email protected]>
Subject: Re: Event.pm
Organization: Gossamer Threads

On Wed, 8 May 2002 10:46:07 +0530 Joshua N Pritikin <[email protected]> wrote:
> On Tue, May 07, 2002 at 03:28:14PM -0700, Scott Beck wrote:
> > I'm using your event module for a daemon that communicates through
> > unix domain sockets. When I get to a point that I am no longer using a
> > socket I call your->cancel() method on it's watcher. If I do this and
> > do not close the socket my program starts using more and more CPU. If
> > I close the socket Event.pm gives me a warning:
> >     Event: '?? gpanel_server:305' was unexpectedly closed at
> >     gpanel_server line 112
> > 
> > Is there something I am missing here? If you would like I can make a
> > short example of my program and send it to you. I'm on slackware linux
> > with perl 5.6.1.
> 
> Yes, please send a short script to reproduce the problem.
> 
> Thanks.

Here you go. I tried to make it as short as possible. You will find the close()
I was referring to on line 75 of server.pl. Let me know if you need anything else.

Cheers,

Scott

-------------------- Gossamer Threads Inc. ----------------------
Scott Beck                      Email: [email protected]
Lead Software Developer         Phone: (604) 687-5804
http://www.gossamer-threads.com Fax:   (604) 687-5806

server.pl (application/x-perl, 2.6 KB)

#!/usr/bin/perl -w

# server.pl
use strict;
use warnings;
use constant SOCK => '/tmp/server.sock';

use Event qw/loop/;
use POSIX qw(fcntl_h errno_h :sys_wait_h);
use Socket;
use Symbol qw/gensym/;

$Event::DIED = sub {
    Event::unloop_all();
};

my $Server = gensym;

my (%Out_Buffer, %In_Buffer);

main();

sub main {
    socket($Server, PF_UNIX, SOCK_STREAM, 0)
        or die "Could not create unix socket: $!";

    # Turn off buffering
    select((select($Server), $| = 1)[0]);

    unlink SOCK;
    bind($Server, sockaddr_un(SOCK))
        or die "Could not bind to " . SOCK . "; Reason: $!";
    listen($Server, SOMAXCONN) or die "listen: $!";
    Event->io(
        fd   => $Server,
        poll => 'r',
        cb   => \&handler_input
    );
    warn "Started [$$]\n";
    loop;
}

sub handler_input {
    my ($event) = @_;
    my $watcher = $event->w;
    my $client = $watcher->fd;

    if ($client == $Server) {
        my $client = gensym;
        accept($client, $Server) or die "accept: $!";

        Event->io(
            fd   => $client,
            poll => 'r',
            cb   => \&handler_input
        );
        Event->io(
            fd   => $client,
            poll => 'w',
            cb   => \&handler_output
        );
    }
    else {
        local $SIG{PIPE} = 'IGNORE';
        my $data = '';
        my $rv = sysread($client, $data, POSIX::BUFSIZ());

        unless (defined($rv) and length($data)) {
            delete $In_Buffer{$client};
            delete $Out_Buffer{$client};
            $watcher->cancel;
            close $client; # If I remove this close I start spinning
            return;
        }

        $In_Buffer{$client} .= $data;
        if ($In_Buffer{$client} =~ s/(.*)\n//) {
            warn "<-- $1\n";
            if ($1 eq 'Hi') {
                $Out_Buffer{$client} = "Why hello there\n";
            }
        }
    }
}

sub handler_output {
    my ($event) = @_;
    my $watcher = $event->w;
    my $client = $watcher->fd;
    return unless exists $Out_Buffer{$client};

    local $SIG{PIPE} = 'IGNORE';
    warn "--> $Out_Buffer{$client}";
    my $rv = syswrite($client, $Out_Buffer{$client});
    unless (defined $rv) {
        warn "We were suppose to be able to write but couldn't";
        delete $In_Buffer{$client};
        delete $Out_Buffer{$client};
        $watcher->cancel;
        return;
    }

    if ($rv == length($Out_Buffer{$client})) {
        substr($Out_Buffer{$client}, 0, $rv) = '';
        delete $Out_Buffer{$client} unless length $Out_Buffer{$client};
    }
    else {
        delete $In_Buffer{$client};
        delete $Out_Buffer{$client};
        $watcher->cancel;
    }
}

client.pl (application/x-perl, 1.8 KB)

#!/usr/bin/perl -w

use strict;
use warnings;

use constant SOCK => '/tmp/server.sock';

use Event qw/loop unloop/;
use POSIX qw(fcntl_h errno_h :sys_wait_h);
use Socket;
use Symbol qw/gensym/;

my ($Out_Buffer, $In_Buffer);

main();

sub main {
    my $client = gensym;

    socket($client, PF_UNIX, SOCK_STREAM, 0)
        or die "Could not create unix socket: $!";
    connect($client, sockaddr_un(SOCK))
        or die "Connect: $!";

    # Turn off buffering
    select((select($client), $| = 1)[0]);

    $Out_Buffer = "Hi\n";
    Event->io(
        fd   => $client,
        poll => 'r',
        cb   => \&handler_input
    );
    Event->io(
        fd   => $client,
        poll => 'w',
        cb   => \&handler_output
    );
    loop;
}

sub handler_input {
    my ($event) = @_;
    my $watcher = $event->w;
    my $client = $watcher->fd;

    local $SIG{PIPE} = 'IGNORE';
    my $data = '';
    my $rv = sysread($client, $data, POSIX::BUFSIZ());

    unless (defined($rv) and length($data)) {
        warn "Connectiong closed\n";
        unloop;
    }
    $In_Buffer .= $data;
    if ($In_Buffer =~ s/(.*)\n//) {
        warn "<-- $1\n";
        if ($1 eq "Why hello there") {
            warn "All done\n";
            close $client;
            unloop;
        }
    }
}

sub handler_output {
    my ($event) = @_;
    my $watcher = $event->w;
    my $client = $watcher->fd;
    return unless length $Out_Buffer;

    local $SIG{PIPE} = 'IGNORE';
    warn "--> $Out_Buffer";
    my $rv = syswrite($client, $Out_Buffer);
    unless (defined $rv) {
        warn "We were suppose to be able to write but couldn't";
        close $client;
        unloop;
    }

    if ($rv == length($Out_Buffer)) {
        substr($Out_Buffer, 0, $rv) = '';
    }
    else {
        warn "Problems: $!";
        close $client;
        unloop;
    }
}