Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
Hi,

i've a problem run this script.

What should it do:
Run under Linux and v5.10.0 built for arm-linux-gnueabi-thread-multi. I'll like to make a TCP-socket-server to which some clients could connect. If connected the client send a string which is directly sended to serial port and a connected AVR. The AVR sends an answer which is sended back to the clients. later on i'll build this up to save data in a database and much more.

Where are my problems:
I start the server, the socket is open, clients connect(ed). ok. but if a client closes its connection, the server script wend mad, i got an Error #9 on Serialport with Ressource unavailable at this time. but i could not recognize a connection between closing client an unavailable serialport.

second if i do $serialin = $serialport->lookfor() or $errorwithserial = 1; instead of $serialin = $serialport->lookfor();, i got the error #9 directly after starting the script and send the first serial_writes.

did i mad mistakes in threading or serialport?

Regards Fly


#!/usr/bin/perl use warnings; use strict; use IO::Socket; use threads; use threads::shared; use Device::SerialPort; sub serial_open(); sub serial_get(); sub serial_write($); sub process_clients(); system("/usr/bin/clear"); $|++; print "$$ Server started\n";; our @clients : shared; @clients = (); my $serialdevice = "/dev/ttyUSB0"; my $server = new IO::Socket::INET ( Timeout => 7200, Proto => "tcp", LocalPort => 8000, Reuse => 1, Listen => 3 ); my $num_of_client = -1; my $serialport = ""; my $serialin : shared = ""; my $count = 0; our $errorwithserial : shared = 0; serial_open; my $serialthread = threads->new( \&serial_get )->detach(); serial_write("#.lcdinit.#"); serial_write("#.v.#"); while (1 && $serialport ne "" && $errorwithserial == 0) { my $client; do { $client = $server->accept; } until ( defined($client) ); my $peerhost = $client->peerhost(); print "Connected: $client, $peerhost, Nummer = ", ++$num_of_client +, "\n"; my $fileno = fileno $client; push (@clients, $fileno); my $thr = threads->new( \&process_clients, $client, $fileno, $peer +host )->detach(); } # end of main thread sub serial_get() { while (1 && $errorwithserial == 0) { my $gotData = 1; $serialin = $serialport->lookfor(); # $serialin = $serialport->lookfor() or $errorwithserial = 1; if ($gotData == 1 && $errorwithserial == 0) { if ($serialin) { $serialin =~ s/^\s+$//m; $serialin =~ s/^\r+$//m; $serialin =~ s/^\n+$//m; $serialin =~ s/\s+$//m; $serialin =~ s/\r+$//m; $serialin =~ s/\n+$//m; print "UART in.: " . $serialin . " \n\r"; foreach my $fn (@clients) { my $fh; open $fh, ">&=$fn\r" or warn $! and die("tod"); } } } elsif ($errorwithserial == 1) { print "Error Serialport: " . $serialport . " -> " . $! . " +\n\r"; exit; } sleep 1; } } sub serial_write($) { my $cmd = $_[0]; $cmd =~ s/\s+$//m; $cmd =~ s/\r+$//m; $cmd =~ s/\n+$//m; if ($serialport) { if (substr($cmd, 0, 2) eq "#." && substr($cmd, length($cmd) - +2, 2) eq ".#") { $cmd = substr($cmd, 2, length($cmd) - 4); my $count_out = "0"; $serialport->write("$cmd\r"); print "UART out: $cmd\n\r"; } else { print "Unknown -> " . $cmd . " -> " . substr($cmd, 0, 2) . + " & " . substr($cmd, length($cmd) - 2, 2) . "\n\r"; } } } sub process_clients() { my ($lclient, $lfileno, $lpeer) = @_; if ($lclient->connected) { print $lclient "$lpeer -> Welcome -> " . localtime . "\n\r"; +# is sendet to client serial_write("#.v.#\r"); while(<$lclient> && $errorwithserial == 0) { my $command = $_; print $lclient "$command\r"; serial_write ($_); } print $lclient "$lpeer -> Welcome\n\r"; # it will never be se +nded! if ($errorwithserial == 0) { print $lclient "$lpeer -> Good Bye\n\r"; # it will never +be sended! } else { print $lclient "$lpeer -> Good Bye with Error -> " . $! . +"\n\r"; # it will never be sended! } } close ($lclient); @clients = grep {$_ !~ $lfileno} @clients; } sub serial_open() { $serialport = Device::SerialPort->new($serialdevice) or die "(new) +!"; $serialport->databits(8) or die "(databits)!"; $serialport->baudrate(115200) or die "(baudrate)!"; $serialport->parity("none") or die "(parity)!"; $serialport->stopbits(1) or die "(stopbits)!"; $serialport->read_char_time(5) or die "(read_char_time)!"; $serialport->read_const_time(500) or die "(read_const_time)!"; print "($serialport) $serialdevice open\n\r"; } __END__

In reply to TCP Socket and Serial Port by FlyingEagle

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (4)
As of 2024-03-29 15:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found