[Perl] Port série, Device::SerialPort; et STDOUT

Patrice Karatchentzeff patrice.karatchentzeff at gmail.com
Lun 13 Mar 10:07:01 CET 2017


Salut les mongueurs

J'ai un petit souci avec une redirection sur la sortie standard en jouant
avec les ports série. Le but de la manipulation est de récupérer les
données d'un appareil de mesure branché sur un port série (USB en fait).

Voici un extrait crash-test du programme.

Pour ceux qui veulent tester tout, voici un exemple sous Linux (pour
Windows, il n'est pas encore prêt pour le desktop à mon dernier test de
décembre 2016 😉) :

# Créer une liaison de ports série virtuels :
% socat -d -d pty,raw,echo=0 pty,raw,echo=0
2017/03/13 09:36:06 socat[29169] N PTY is /dev/pts/7
2017/03/13 09:36:06 socat[29169] N PTY is /dev/pts/8
2017/03/13 09:36:06 socat[29169] N starting data transfer loop with FDs
[5,5] and [7,7]

# Lancement de mon scrit
% ./getserial.pl /dev/pts/8

# envoi de données dans le port série
%  echo coucou >| /dev/pts/7

# ce qui se passe en sortie de mon programme:
% ./getserial.pl /dev/pts/8
Debug level: /dev/pts/8 = 0 at ./getserial.pl line 36.

Data Bit Options:  none odd evencoucou
coucou
coucou

etc.

Maintenant, si je veux rediriger la sortie de mon programme *en externe *:

 % ./getserial.pl /dev/pts/8 >>| toto.txt

Le fichier ne se remplit pas...

Je ne comprends pas pourquoi...

Voici le programme simplifié :

% cat getserial.pl
#!/usr/bin/perl

use strict;
use warnings;
use English;

use Device::SerialPort;
my $port = Device::SerialPort->new("$ARGV[0]")
  or die "can't open port: $OS_ERROR\n";


$port->baudrate(115200); # Configure this to match your device
#$port->baudrate(19200); # Configure this to match your device
$port->databits(8);
$port->parity("odd");
$port->stopbits(1);
$port->handshake('on');
#$port->handshake("xoff");
$port->buffers(4096, 4096);
$port->stty_icrnl(1)     || die "failed setting convert cr to new line";
$port->user_msg(1);           # misc. warnings
$port->error_msg(1);          # hardware and data errors
$port->debug(1);              # debug on at 0, 1 otherwise
#$port->read_const_time(500); # const time for read (milliseconds)
$port->read_char_time(0);
$port->write_settings;

# print port configuration
my @data_opt = $port->parity; # list context
print "\nData Bit Options: ";
foreach $a (@data_opt) { print " $a"; }

# begin reading serial port
#$port->write("\nBegin perl serial listener\n");

while (1) {
  my $char = $port->lookfor();
    if ($char) {
        print "$char\n";
    }
#  $port->lookclear; # needed to prevent blocking
  }

​Any help welcome 😁

Merci

PK​


-- 
      |\      _,,,---,,_           Patrice KARATCHENTZEFF
ZZZzz /,`.-'`'    -.  ;-;;,_   mailto:patrice.karatchentzeff at gmail.com
     |,4-  ) )-,_. ,\ (  `'-'      http://p.karatchentzeff.free.fr
    '---''(_/--'  `-'\_)
-------------- section suivante --------------
Une pièce jointe HTML a été nettoyée...
URL: <http://listes.mongueurs.net/mailman/private/perl/attachments/20170313/bbe08aac/attachment.html>


Plus d'informations sur la liste de diffusion Perl