The cause of the problem you mentioned is that $fh is always ready to read. (Well, only until you read through it once, but you never get to that point.)
But that's not your only problem.
- You have a single buffer, a single state and a single handle to ~/.somefile for multiple sockets.
- While the recv from the first while pass won't block, there's no assurances the recv from the second pass won't. You've invalidated the select.
- You're writing to the wrong socket.
- The write to the socket could block, invalidating the select.
- No checking for socket closure (or error).
- You shouldn't specify LocalHost on a server socket unless you really want to prevent people from using other interfaces. For example, you were preventing connections from 127.0.0.1.
- Autoflush is already on (not that flushing means anything on server sockets).
- CLASS->new(...) doesn't suffer from the problems new CLASS (...) does. The latter syntax is strongly discouraged.
#!/usr/bin/perl
use strict;
use warnings;
use IO::Select qw( );
use IO::Socket::INET qw( );
my $sock = IO::Socket::INET->new(
Proto => 'tcp',
LocalPort => 1200,
Listen => 5,
Reuse => 1,
)
or die "Socket couldn't be created: $!\n";
my %clients;
# $clients{$rh}{state} = 'CONNECTED';
# $clients{$rh}{state} = 'UNCONNECTED';
# $clients{$rh}{rx_txt} = '';
my $select = new IO::Select();
$select->add($sock);
sub handle_connection {
my ($rh) = @_;
# This function should spawn a thread to do its work because
# 1) it could take a while if the file isn't small, and
# 2) the write operation could block.
my $client = $clients{$rh};
# Convenient alias.
our $state; local *state = \($client{state});
open(my $fh, '<', '~/.somefile');
# Needs error handling here.
while (<$fh>) {
last if $state ne 'CONNECTED';
print $rh $_;
}
$state = 'UNCONNECTED';
$select->remove($rh);
delete $clients{$rh};
print "UNCONNECTED (done)\n";
}
while (1) {
my @ready = $select->can_read();
foreach my $rh (@ready) {
print "GOT SOMETHING!\n";
if ($rh == $sock) {
my $conn = $sock->accept();
$select->add($conn);
print "CONNECTION ADDED\n";
$clients{$conn} = {
state => 'UNCONNECTED',
rx_txt => '',
};
next;
}
my $client = $clients{$rh};
# Convenient aliases.
our $rx_txt; local *rx_txt = \($client{rx_txt});
our $state; local *state = \($client{state});
my $bytes_read = read($rh, $rx_txt, 1024, length($rx_txt));
if (!defined($bytes_read)) {
# Socket error.
$state = 'UNCONNECTED';
$select->remove($rh);
delete $clients{$rh};
print "UNCONNECTED by socket error)\n";
next;
}
if (!bytes_read) {
# Socket closed.
$state = 'UNCONNECTED';
$select->remove($rh);
delete $clients{$rh};
print "UNCONNECTED by client\n";
next;
}
my $cmd = $rx_txt =~ s/^(.*)\n//
or next;
if ($cmd ne 'HELLO') {
$state = 'UNCONNECTED';
$select->remove($rh);
delete $clients{$rh};
print "UNCONNECTED by invalid request\n";
next;
}
$state = 'CONNECTED';
print "CONNECTED\n";
handle_connection($rh);
}
}
Untested.
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|