Thread::Queue for non-threaded apps

[kschwab]

Category:

Networking Code

Description:

I needed functionality somewhat like Thread::Queue for passing data on a queue between a parent and it's forked child. Since non-threaded perl has no Thread::Queue, I used this. It's a bit quick and dirty, but works for me. == Kerry Save money

package Fork::Queue;
use IO::Socket;

sub new {
    my($this) = @_;
    my $class = ref($this) || $this;
    my $self = {};
    bless $self, $class;
    $self->mksockpair();
    return $self;
}
# make the socketpair
sub mksockpair {
    my($self)=@_;
    my $creator=IO::Socket->new() or die();
    my($reader,$writer);
    ($reader,$writer)=$creator->socketpair(AF_UNIX,SOCK_STREAM,PF_UNSP
+EC);
    shutdown($reader,1);
    shutdown($writer,0);
    $self->{'READER'}=$reader;
    $self->{'WRITER'}=$writer;
}
# method to put something on the queue
sub enqueue {
    my($self,@data)=@_;
    my($header,$buffer,$tosend);
    my($handle)=$self->{'WRITER'};
    foreach my $item (@data) {
        $header=pack("N",length($item));
        $buffer=$header . $item;
        $tosend=length($buffer);
        print $handle $buffer;
        $handle->flush;
    }
}
#
# method to pull something off the queue
#
sub dequeue {
    my($self)=@_;
    my($header,$data);
    my($toread)=4;
    my($bytes_read)=0;
    my($handle)=$self->{'READER'};
    # read 4 byte header
    while ($bytes_read < $toread) {
       $bytes_read+=read($handle,$header,$toread,$bytes_read);  
    }
    $toread=unpack("N",$header);
    $bytes_read=0; 
    # read the actual data
    while ($bytes_read < $toread) {
       $bytes_read+=read($handle,$data,$toread,$bytes_read);
    }
    return $data;
}
1;
#
# 
my $q=Fork::Queue->new();
if (my $pid=fork()) {
    # parent, enqueue a list a scalars
    $q->enqueue("some","random","list","of","stuff","die");
} else {
    # child, pull items off the queue, exit when we get "die"
    # (otherwise dequeue blocks and the child never exits)
    my($item);
    while ($item=$q->dequeue()) {
        if ($item eq "die") {
            exit;
        }
        print "$item\n";
    }
}