Net::SeedServe - Perl module for implementing a seed server (should not


Net-SeedServe documentation Contained in the Net-SeedServe distribution.

Index


Code Index:

NAME

Top

Net::SeedServe - Perl module for implementing a seed server (should not be used directly - use Net::SeedServe::Server instead).

DESCRIPTION

Top

Consult the documentation of Net::SeedServe::Server.

METHODS

Top

$server = Net::SeedServe->new(port => $port, status_file => $status_filename)

Constructs a new seed server object on a certain port with a certain status file.

$server->loop();

Starts a loop.

AUTHOR

Top

Shlomi Fish, <shlomif@iglu.org.il>

COPYRIGHT AND LICENSE

Top


Net-SeedServe documentation Contained in the Net-SeedServe distribution.

package Net::SeedServe;

use 5.008;
use strict;
use warnings;

use IO::Socket::INET;
use IO::All;

our $VERSION = '0.2.1';

sub new
{
    my $class = shift;
    my $self = +{};
    bless $self, $class;
    $self->_init(@_);
    return $self;
}

sub _init
{
    my $self = shift;

    my %args = (@_);

    my $port = $args{'port'} or
        die "Port not specified!";
    
    $self->{'port'} = $port;

    $self->{'status_file'} = $args{'status_file'} or
        die "Success file not specified";

    return 0;
}

sub _update_status_file
{
    my $self = shift;
    my $string = shift;
    
    io()->file($self->{'status_file'})->print("$string\n");
}

sub loop
{
    my $self = shift;

    my $serving_socket;

    $serving_socket = 
        IO::Socket::INET->new(
            Listen    => 5,
            LocalAddr => 'localhost',
            LocalPort => $self->{'port'},
            Proto     => 'tcp'
        );
    if (!defined($serving_socket))
    {
        $self->_update_status_file("Status:Error");
        die $@;
    }

    $self->_update_status_file(
        "Status:Success\tPort:" . $self->{'port'} . "\tPID:$$"
        );

    my @queue;
    my $next_seed;

    my $clear = sub {
        @queue = ();
        $next_seed = 1;
    };

    $clear->();

    while (my $conn = $serving_socket->accept())
    {
        my $request = $conn->getline();
        my $response;
        if ($request =~ /^FETCH/)
        {
            my $seed;
            if ($seed = shift(@queue))
            {
                $response = $seed;
                $next_seed = $seed+1;
            }
            else
            {
                $response = $next_seed++;
            }
        }
        elsif ($request =~ /^CLEAR/)
        {
            $clear->();
            $response = "OK";
        }
        elsif ($request =~ /^ENQUEUE ((?:\d+,)+)/)
        {
            my $nums = $1;
            $nums =~ s{,$}{};
            push @queue, split(/,/, $nums);
            $response = "OK";
        }
        else
        {
            $response = "ERROR";
        }
        $conn->print("$response\n");
    }
}

1;
__END__