Commits

Anonymous committed 8c5202a

Added a working implementation of the SeedServe service and a comprehensive
test file to test the protocol.

Comments (0)

Files changed (9)

rand-seed-serve/Net-SeedServe/Changes

+Revision history for Perl extension Net::SeedServe.
+
+0.01  Fri Feb 18 01:19:25 2005
+	- original version; created by h2xs 1.23 with options
+		-X Net::SeedServe
+

rand-seed-serve/Net-SeedServe/MANIFEST

+Changes
+Makefile.PL
+MANIFEST
+README
+t/protocol.t
+lib/Net/SeedServe.pm
+lib/Net/SeedServe/Server.pm
+TEMP/meaningless.txt
+META.yml                                 Module meta-data (added by MakeMaker)

rand-seed-serve/Net-SeedServe/META.yml

+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
+name:         Net-SeedServe
+version:      0.1.0_00
+version_from: lib/Net/SeedServe.pm
+installdirs:  site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17

rand-seed-serve/Net-SeedServe/Makefile.PL

+use 5.008005;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    NAME              => 'Net::SeedServe',
+    VERSION_FROM      => 'lib/Net/SeedServe.pm', # finds $VERSION
+    PREREQ_PM         => {}, # e.g., Module::Name => 1.1
+    ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM  => 'lib/Net/SeedServe.pm', # retrieve abstract from module
+       AUTHOR         => 'Shlomi Fish <shlomi@mandrakesoft.com>') : ()),
+);

rand-seed-serve/Net-SeedServe/README

+Net-SeedServe version 0.01
+==========================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+  blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2005 by Shlomi Fish
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.5 or,
+at your option, any later version of Perl 5 you may have available.
+
+

rand-seed-serve/Net-SeedServe/TEMP/meaningless.txt

Empty file added.

rand-seed-serve/Net-SeedServe/lib/Net/SeedServe.pm

+package Net::SeedServe;
+
+use 5.008;
+use strict;
+use warnings;
+
+use IO::Socket::INET;
+use IO::All;
+
+our $VERSION = '0.1.0_00';
+
+sub new
+{
+    my $class = shift;
+    my $self = +{};
+    bless $self, $class;
+    $self->initialize(@_);
+    return $self;
+}
+
+sub initialize
+{
+    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 set_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->set_status_file("Status:Error");
+        die $@;
+    }
+
+    $self->set_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__
+
+=head1 NAME
+
+Net::SeedServe - Perl extension for blah blah blah
+
+=head1 SYNOPSIS
+
+  use Net::SeedServe;
+  blah blah blah
+
+=head1 DESCRIPTION
+
+Stub documentation for Net::SeedServe, created by h2xs. It looks like the
+author of the extension was negligent enough to leave the stub
+unedited.
+
+Blah blah blah.
+
+=head2 EXPORT
+
+None by default.
+
+
+
+=head1 AUTHOR
+
+Shlomi Fish, E<lt>shlomif@iglu.org.ilE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+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.
+
+=cut

rand-seed-serve/Net-SeedServe/lib/Net/SeedServe/Server.pm

+package Net::SeedServe::Server;
+
+use strict;
+use warnings;
+
+use Net::SeedServe;
+use IO::All;
+use Time::HiRes qw(usleep);
+
+sub new
+{
+    my $class = shift;
+    my $self = {};
+    bless $self, $class;
+    $self->initialize(@_);
+    return $self;
+}
+
+sub initialize
+{
+    my $self = shift;
+    my %args = (@_);
+    $self->{'status_file'} = $args{'status_file'} or
+        die "Unknown status file!";
+
+    return 0;
+}
+
+sub start
+{
+    my $self = shift;
+    my $status_file = $self->{'status_file'};
+
+    for(my $port = 3000; ; $port++)
+    {
+        unlink($status_file);
+        my $fork_pid = fork();
+        if (!defined($fork_pid))
+        {
+            die "Fork was not successful!";
+        }
+        if (! $fork_pid)
+        {
+            # The child will start the service.
+            my $server = 
+                Net::SeedServe->new(
+                    'status_file' => $status_file,
+                    'port' => $port,
+                );
+
+            eval
+            {
+                $server->loop();
+            };
+            if ($@)
+            {
+                exit(-1);
+            }
+        }
+        else
+        {
+            # The parent will try to find the child's status
+            while (! -f $status_file)
+            {
+                usleep(5000);
+            }
+            my $text = io()->file($status_file)->getline();
+            if ($text eq "Status:Success\tPort:$port\tPID:$fork_pid\n")
+            {
+                # The game is on - the service is running and everything's OK.
+                $self->{'port'} = $port;
+                $self->{'server_pid'} = $fork_pid;
+                return +{ 'port' => $port };
+            }
+            else
+            {
+                waitpid($fork_pid, 0);
+            }
+        }
+    }
+}
+
+sub stop
+{
+    my $self = shift;
+
+    my $pid = $self->{'server_pid'};
+    kill("TERM", $pid);
+
+    waitpid($pid, 0);
+}
+
+1;
+

rand-seed-serve/Net-SeedServe/t/protocol.t

+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 20;
+
+use IO::All;
+# TEST
+BEGIN { use_ok('Net::SeedServe') };
+
+use Net::SeedServe::Server;
+
+# First of all - start the service.
+my $server = 
+    Net::SeedServe::Server->new(
+        'status_file' => "TEMP/server-status.txt",
+    );
+
+my $ret = $server->start();
+my $port = $ret->{'port'};
+
+# The eval { } is to trap exceptions, so we can safely stop the server at 
+# cleanup.
+eval {
+    # Phase 1 : Test regular initiatory seeds, with a possible clear.
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "1\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "2\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "3\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("CLEAR\n");
+        # TEST
+        is ($conn->getline(), "OK\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "1\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "2\n");
+    }
+    # Phase 2 - test the ENQUEUE method.
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("ENQUEUE 5,\n");
+        # TEST
+        is ($conn->getline(), "OK\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "5\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "6\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("ENQUEUE 10,200,398,\n");
+        # TEST
+        is ($conn->getline(), "OK\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "10\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "200\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "398\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "399\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("ENQUEUE 24,39,\n");
+        # TEST
+        is ($conn->getline(), "OK\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "24\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("ENQUEUE 805,\n");
+        # TEST
+        is ($conn->getline(), "OK\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "39\n");
+    }
+    {
+        my $conn = io("localhost:$port");
+        $conn->print("FETCH\n");
+        # TEST
+        is ($conn->getline(), "805\n");
+    }
+};
+
+$server->stop();
+