Hi monks,
i have a arduino board here which is connected via usb to my linux server.
On the linux server i have written a server / daemon in perl and a client also in perl, which communicates with the perl server via tcp sockets.
The perl server creates a new thread for every incoming connection.
And here is my problem: If i detach the threads or join them, when they are done it crashes my serial connection to the arduino board. If i keep the threads alive doing nothing, everything works, but my perl server generates constantly threads and never cleans them up. What am i doing wrong?
Here is some code. Hope i cover the main section. The whole code is lengthy. I can post all if needed.
Perl server:
#! /usr/bin/perl -w
use threads;
use threads::shared;
use IO::Socket;
use Device::SerialPort;
use DateTime;
$| = 1;
my $listen = IO::Socket::INET->new(
ReuseAddr => 1,
Reuse => 1,
Listen => SOMAXCONN,
Proto => 'tcp',
LocalAddr => 'localhost:9927',
Timeout => 1
) or die "Failed to create socket!\n";
our $usb_lock : shared;
our $arduino = undef;
sub getArduinoConnection {
#my $oldport = shift;
#$arduino->close() if defined;
my $arduino = Device::SerialPort->new("/dev/serial/by-id/usb-Ardui
+no__www.arduino.cc__Arduino_Mega_2560_74136333033351011152-if00");
if ( defined( $arduino ) ) {
$arduino->baudrate(9600);
$arduino->parity("none");
$arduino->databits(8);
$arduino->stopbits(1);
$arduino->read_char_time(0);
$arduino->read_const_time(500);
$arduino->write_settings || undef $arduino;
writelog( "server:[portSet]" );
} else {
writelog( "server:[portSet]: failed" );
}
return $arduino;
}
....
sub handle_connection {
#sleep( 1 );
my $socket = shift;
my $local_arduino = shift;
my $clientport = $socket->peerport();
$socket->autoflush(1);
while ( my $cmd = <$socket> ) {
# get full command or die
my $count = 0;
while ( !cmd_complete($cmd) ) {
$cmd .= <$socket>;
$count++;
if ( $count > 20 ) {
writelog( "server:" . $clientport . "[cmdInc]: no cmd
+end" );
return 0;
}
}
chomp($cmd);
writelog( "server:" . $clientport . "[cmdInc]: " . decode_cmd(
+ $cmd ) );
{
# send command to arduino
lock( $usb_lock );
writelog( "server:" . $clientport . "[lockusb]" );
$local_arduino->write($cmd);
# get arduinos answer
my $answer = ".";
while ( $answer ne "" ) {
$answer = getLineFromArduino();
writelog( "server:" . $clientport . "[cmdAnswer]: $ans
+wer" );
#print $socket "$answer\n";
if ( $answer eq "Command end" ) {
last;
}
}
# respond to client
if ( $answer eq "Command end" ) {
writelog( "server:" . $clientport . "[sendToClient]: \
+"ok\"" );
print $socket "ok\n";
} else {
writelog( "server:" . $clientport . "[sendToClient]: \
+"fail\"" );
print $socket "fail\n";
}
writelog( "server:" . $clientport . "[unlockusb]" );
}
return 1;
}
}
my $last_validation = -10; #in the past
#main loop
while ( 1 ) {
foreach $thr (threads->list) {
# Don't join the main thread or ourselves
#print $thr->tid;
if ($thr->tid && $thr->is_joinable() ) { #&& !threads::equal($
+thr, threads->self)
#$thr->join;
}
}
# validate arduino every 10 seconds
# sleep if arduino not alive
if ( time > ( $last_validation + 30 ) ) {
lock( $usb_lock );
$last_validation = time;
$arduino = validateArduinoConnection( $arduino );
until ( defined( $arduino ) ) {
$arduino = validateArduinoConnection( $arduino );
sleep( 1 );
}
clearUSBdata();
}
if (my $socket = $listen->accept) {
#async(\&handle_connection, $socket);
threads->create(\&handle_connection, $socket, $arduino );
}
}
Perl client:
#! /usr/bin/perl -w
use threads;
use IO::Socket;
use DateTime;
my $socket = IO::Socket::INET->new(
Proto => 'tcp',
PeerAddr=> 'localhost',
PeerPort=> "9927",
Reuse => 1,
Timeout => 1
) or die "ERROR in Socket Creation : $!\n";
my $select = IO::Select->new($socket) or die "IO::Select $!";
my $localport = $socket->sockport();
sub writelog {
my $dt = DateTime->now;
my $date = $dt->ymd . " " . $dt->hms;
my ( $line ) = @_;
open (LOGFILE, '>>/var/log/home/roll.log');
print LOGFILE "$date - $line\n";
close (LOGFILE);
}
sub decode_cmd {
my $cmd = shift;
my @str = split(//, $cmd);
my @cmds = ();
my $cmd_str = "";
for ( my $i = 0; $i < @str; $i++ ) {
push( @cmds, ord( $str[ $i ] ) );
}
return join( ',', @cmds );
}
#main
# translate argument int to chr and build command string
my $num_args = $#ARGV + 1;
my $cmd = "";
for ( my $i = 0; $i < $num_args; $i++ ) {
if ( $ARGV[$i] < 256 ) {
$cmd .= chr($ARGV[$i]);
} else {
$cmd .= pack("n",$ARGV[$i]);
}
}
$cmd = chr(254) . $cmd . chr(255); # 254=cmd begin 255=cmd stop
writelog( "client:" . $localport . "[sendCmdToServer]: " . decode_cmd(
+ $cmd ) );
# send command to server
print $socket "$cmd\n";
# wait for servers answer
my $line = "";
if ( $select->can_read(5.25) ) {
chomp( $line = <$socket> );
}
writelog( "client:" . $localport . "[serverAnswer]: \"$line\"" );
Any help greatly appreciated.
-
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.