File Coverage

blib/lib/Net/SeedServe.pm
Criterion Covered Total %
statement 34 57 59.6
branch 3 14 21.4
condition n/a
subroutine 9 10 90.0
pod 2 2 100.0
total 48 83 57.8


line stmt bran cond sub pod time code
1             package Net::SeedServe;
2              
3 6     6   226944 use 5.008;
  6         21  
4 6     6   33 use strict;
  6         9  
  6         132  
5 6     6   30 use warnings;
  6         14  
  6         171  
6              
7 6     6   5871 use IO::Socket::INET;
  6         152345  
  6         40  
8 6     6   3700 use IO::All;
  6         12  
  6         49  
9              
10             our $VERSION = '0.2.5';
11              
12             sub new
13             {
14 3     3 1 94 my $class = shift;
15 3         128 my $self = +{};
16 3         78 bless $self, $class;
17 3         365 $self->_init(@_);
18 3         38 return $self;
19             }
20              
21             sub _init
22             {
23 3     3   28 my $self = shift;
24              
25 3         165 my %args = (@_);
26              
27 3 50       142 my $port = $args{'port'} or
28             die "Port not specified!";
29              
30 3         189 $self->{'port'} = $port;
31              
32 3 50       633 $self->{'status_file'} = $args{'status_file'} or
33             die "Success file not specified";
34              
35 3         22 return 0;
36             }
37              
38             sub _update_status_file
39             {
40 3     3   9 my $self = shift;
41 3         10 my $string = shift;
42              
43 3         56 io()->file($self->{'status_file'})->print("$string\n");
44             }
45              
46             sub loop
47             {
48 3     3 1 19 my $self = shift;
49              
50 3         8 my $serving_socket;
51              
52             $serving_socket =
53             IO::Socket::INET->new(
54             Listen => 5,
55             LocalAddr => 'localhost',
56 3         169 LocalPort => $self->{'port'},
57             Proto => 'tcp'
58             );
59 3 50       8388 if (!defined($serving_socket))
60             {
61 3         20 $self->_update_status_file("Status:Error");
62 3         34717 die $@;
63             }
64              
65             $self->_update_status_file(
66 0           "Status:Success\tPort:" . $self->{'port'} . "\tPID:$$"
67             );
68              
69 0           my @queue;
70             my $next_seed;
71              
72             my $clear = sub {
73 0     0     @queue = ();
74 0           $next_seed = 1;
75 0           };
76              
77 0           $clear->();
78              
79 0           while (my $conn = $serving_socket->accept())
80             {
81 0           my $request = $conn->getline();
82 0           my $response;
83 0 0         if ($request =~ /^FETCH/)
    0          
    0          
84             {
85 0           my $seed;
86 0 0         if ($seed = shift(@queue))
87             {
88 0           $response = $seed;
89 0           $next_seed = $seed+1;
90             }
91             else
92             {
93 0           $response = $next_seed++;
94             }
95             }
96             elsif ($request =~ /^CLEAR/)
97             {
98 0           $clear->();
99 0           $response = "OK";
100             }
101             elsif ($request =~ /^ENQUEUE ((?:\d+,)+)/)
102             {
103 0           my $nums = $1;
104 0           $nums =~ s{,$}{};
105 0           push @queue, split(/,/, $nums);
106 0           $response = "OK";
107             }
108             else
109             {
110 0           $response = "ERROR";
111             }
112 0           $conn->print("$response\n");
113             }
114             }
115              
116             1;
117             __END__