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

[Patrice Karatchentzeff]

Avec le nouveau script, c'est mieux :-)

(c'est du crash : ne faîtes pas trop attention au style)

#!/usr/bin/perl

use strict;
use warnings;
use English;

# For Linux
# do apt install libdevice-serialport-perl in Debian before !
#   for testting, do apt install socat
#   socat -d -d pty,raw,echo=0 pty,raw,echo=0
#  depending of this previsous screen out, do
#     ./getserial.pl /dev/pts/12 9600 60 toto.txt
#     echo coucou > /dev/pts/11
#

usage();

my $line    = "$ARGV[0]";
my $baud    = "$ARGV[1]";
my $runtime = "$ARGV[2]";
my $file    = "$ARGV[3]";
my $fh;

# open saved data file
open $fh, '>', $file
  or die "can't open file: $OS_ERROR\n";

print $fh "test0\n";


# manage serial port
use Device::SerialPort;
my $port = Device::SerialPort->new("$line")
  or die "can't open port: $OS_ERROR\n";

# For Windows. You only need one or the other.
# Uncomment these for Windows and comment out above
#use Win32::SerialPort;
#my $port = Win32::SerialPort->new("COM3");

# manage serial port
# only baudrate is managed from the external line
$port->baudrate($baud); # 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 $fh "test1\n";

# print configuration
my @data_opt = $port->parity; # list context
print "\nData Bit Options: ";
foreach $a (@data_opt) { print " $a"; };
print "\n$line $baud $runtime $file\n";
# begin reading serial port
#$port->write("\nBegin perl serial listener\n");

print $fh "test2\n";

while (1) {
    my $char = $port->lookfor();
#    my $char = $port->read(255);
  if ($char) {
      print $fh "testFH\n";
      print STDOUT "testSTDOUT\n";
      print  "$char\n";
      $port->write("\ntest02");
    }
#  $port->lookclear; # needed to prevent blocking
  }

close $fh;
close $port;

sub usage {
  if ( $#ARGV ne "3" ) {
    print "usage :\n";
    print "   getserial.pl port speed  runtime file\n";
    print "      where : port     = serial port\n";
    print "              seed     = port speed (in bauds)\n";
    print "              runtime  = runtime of the measure (in seconds)\n";
    print "              file     = data saved file\n";
    exit;
    }
}

Le 16 mars 2017 à 14:08, Patrice Karatchentzeff <
patrice.karatchentzeff at gmail.com> a écrit :

> Re moi,
>
> J'ai avancé un peu... En fait, j'ai l'impression que le module Device::SerialPort;
> redéfinit beaucoup de choses...
>
> Je n'arrive pas non plus à écrire dans un fichier par exemple !
>
> Je n'ai rien lu - ou pas compris - si la doc du module en parlait...
>
> Quelqu'un a-t-il une idée comment contourner ?
>
> Merci
>
> PK
>
> 2017-03-13 10:07 GMT+01:00 Patrice Karatchentzeff <
> patrice.karatchentzeff at gmail.com>:
>
>> 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
>>     '---''(_/--'  `-'\_)
>>
>
>
>
> --
>       |\      _,,,---,,_           Patrice KARATCHENTZEFF
> ZZZzz /,`.-'`'    -.  ;-;;,_   mailto:patrice.karatchentzeff at gmail.com
>      |,4-  ) )-,_. ,\ (  `'-'      http://p.karatchentzeff.free.fr
>     '---''(_/--'  `-'\_)
>



-- 
      |\      _,,,---,,_           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/20170316/bfd4ac3e/attachment.html>