| Net-SeedServe documentation | Contained in the Net-SeedServe distribution. |
Net::SeedServe - Perl module for implementing a seed server (should not be used directly - use Net::SeedServe::Server instead).
Consult the documentation of Net::SeedServe::Server.
Constructs a new seed server object on a certain port with a certain status file.
Starts a loop.
Shlomi Fish, <shlomif@iglu.org.il>
Copyright (C) 2005 by Shlomi Fish
This library is free software, you can redistribute and/or modify and/or use it under the terms of the MIT X11 license.
| 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__