Bonjour,
 
je travaille actuellement sur du PERL (nouveau pour moi) et je suis
 
un peu bloqué. Je dois exporter une valeur depuis un serveur web (@IP connue) et je ne
 
trouve pas la commande perl à ecrire dans mon script.
 
Ce langage est il le plus adapté pour faire ce genre de requete ou alors en C/C++
 
Je connais un peu le langage C et C++...
 
Merci pour votre aide
 
Julien

Pour le moment, ce que vous avez écrit ne veut pas dire grand chose, alors difficile d'y répondre.
Il faudrait être plus clair quand à ce que vous voulez faire.
Et oui, Perl est un langage couramment utilisé dans la programmation perl, que ce soit du côté client (Perl et CGI; le langage PHP est à la base une intégration/adaptation de Perl à une utilisation spécifique de script côté serveur) ou client (programmes d'automatisation de requêtes et exploitation du résultat, robots...)
 
A+,

Ok,  Pour faire simple,  
J'ai un compteur energie qui possede une interface web via un mini serveur web intégré. Mon but est de rentrer dans sa base de données et d'en extraire 3 variables qdont j'ai besoin.
 
j'ai trouvé la fonction qui mer permet de rentrer dans la base de données avec mbtget -r3 -a 264 (adresse variable) et @IP
 
Quand je tape cette ligne dans ma fenetre de commande, le serveur me réponde <00264> values 19167. qui est ma consommation.  
maintenant, je voudrais intégré cette requette dans un programme qui me renvoie à intervalle régulier ces valeur dans un fichier .txt ou csv.
 
Voilà pour faire simple et rapide ^^
 
merci

Le code de mbtget est en perl: http://source.perl.free.fr/spip.php?article2
 
Déjà, il faut le désosser pour n'en garder que ce qui vas vous être utile.
 
Je posterai cela tout à l'heure.
 
A+,

#!/usr/bin/perl
 
use strict;
use warnings;
use Socket;
 
# Paramètres ModBus/TCP
my $MODBUS_PORT                                 = 502;
# Codes fonctions
my $READ_COILS                                  = 0x01;
my $READ_DISCRETE_INPUTS                        = 0x02;
my $READ_HOLDING_REGISTERS                      = 0x03;
my $READ_INPUT_REGISTERS                        = 0x04;
my $WRITE_SINGLE_COIL                           = 0x05;
my $WRITE_SINGLE_REGISTER                       = 0x06;
# Codes exceptions
my $EXP_ILLEGAL_FUNCTION                        = 0x01;
my $EXP_DATA_ADDRESS                            = 0x02;
my $EXP_DATA_VALUE                              = 0x03;
my $EXP_SLAVE_DEVICE_FAILURE                    = 0x04;
my $EXP_ACKNOWLEDGE                             = 0x05;
my $EXP_SLAVE_DEVICE_BUSY                       = 0x06;
my $EXP_MEMORY_PARITY_ERROR                     = 0x08;
my $EXP_GATEWAY_PATH_UNAVAILABLE                = 0x0A;
my $EXP_GATEWAY_TARGET_DEVICE_FAILED_TO_RESPOND = 0x0B;
 
# Valeurs par défaut
my $opt_server                                  = 'localhost';
my $opt_server_port                             = $MODBUS_PORT;
my $opt_timeout                                 = 5;
my $opt_unit_id                                 = 1;
my $opt_mb_fc                                   = $READ_HOLDING_REGISTERS;
my $opt_mb_ad                                   = 0;
my $opt_mb_nb                                   = 1;
my $opt_bit_value                               = 0;
my $opt_word_value                              = 0;
 
 
 
$opt_mb_ad = 264;
$opt_server = 'votre.ip.en.chiffres';
# Résolution DNS
my $server_ip = inet_aton($opt_server);
unless ($server_ip) {
  print STDERR 'unable to resolve "'.$server_ip.'"'."\n";
  exit 1;
}
 
my $status = query_info();
until ($status) {
  sleep(10);  # toutes les 10s, a adapter à ses besoins
  $status = query_info();
}
# boucle infinie, a stopper avec un kill
 
 
sub query_info {
  # *** Gestion du dialogue reseau ***
  # Ouverture de la session TCP
  socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
  unless (connect(SERVER, sockaddr_in($MODBUS_PORT, $server_ip))) {
    print STDERR 'connexion au serveur "'.$server_ip.':'.$MODBUS_PORT.'" impossible'."\n";
    return 2;
  }
  
  # Construction de la requête
  my $tx_hd_tr_id   = int(rand 65535);
  my $tx_hd_length  = 6;
  my $tx_hd_pr_id   = 0;
  my $tx_buffer = pack("nnnCCnn", $tx_hd_tr_id, $tx_hd_pr_id , $tx_hd_length, $opt_unit_id, $opt_mb_fc, $opt_mb_ad, $opt_mb_nb);
 
  # Emission de la requête
  send(SERVER, $tx_buffer, 0);
  
  # Attente d'une réponse
  unless (can_read('SERVER', $opt_timeout)) {
    close SERVER;
    print STDERR 'receive timeout'."\n";
    return 1;
  }
 
  # Réception de l'entête
  my ($rx_frame, $rx_buffer);
  recv(SERVER, $rx_buffer, 7, 0);
  $rx_frame = $rx_buffer;
 
  # Décodage de l'entête
  my ($rx_hd_tr_id, $rx_hd_pr_id, $rx_hd_length, $rx_hd_unit_id) = unpack "nnnC", $rx_buffer;
 
  # Vérifie la cohérence de l'entête
  unless (($rx_hd_tr_id == $tx_hd_tr_id) &&
      ($rx_hd_pr_id == 0) &&
      ($rx_hd_length < 256) &&
      ($rx_hd_unit_id == 1)) {
    close SERVER;
    print STDERR 'error in receive frame'."\n";
    return 1;
  }
 
  # Réception du corps du message
  recv(SERVER, $rx_buffer, $rx_hd_length-1, 0);
  $rx_frame .= $rx_buffer;
  close SERVER;
 
  # Décodage du corps du message
  my ($rx_bd_fc, $rx_body) = unpack "Ca*", $rx_buffer;
 
  # Vérification du statut d'exception
  if ($rx_bd_fc > 0x80) {
    # Affichage du code exception
    my ($rx_except_code) = unpack "C", $rx_body;
    print 'exception (code '.$rx_except_code.')'."\n";
  } else {
    ## Lecture de mot
    my ($rx_bd_bc, $rx_read_word_data) = unpack "Ca*", $rx_body;
    # Lecture d'entier de 16 bits
    my @rx_disp_data = unpack 'n*', $rx_read_word_data;
    disp_data(@rx_disp_data);
  }
  return 0;
}
 
 
 
# Attend $timeout secondes que la socket mette à disposition des données
sub can_read {
  my ($sock_handle, $timeout) = @_;
  my $hdl_select = "";
  vec($hdl_select, fileno($sock_handle), 1) = 1;
  return (select($hdl_select, undef, undef, $timeout) == 1);
}
 
 
# Affichage des valeurs reçues
sub disp_data {
  # Affichage du résultat
  # Format csv pour utilisation dans un script
  foreach (@_) {
    printf '%05d;', $_;
  }
  print "\n";
}

 
A toi de modifier la boucle  
my $status = query_info();
until ($status) {
  sleep(10);
  $status = query_info();
}
# boucle infinie, a stopper avec un kill
pour avoir quelque chose qui s'arrête de manière un peu plus propre (bon, c'est pas nécessairement gênant non plus)
Par exemple avec que chose de ce type:

my $status;
my $delay = 300; # une mesure toutes les 5 mn
 
# pour le test
sub query_info() {
  print "lecture des valeurs \n";
  return 0;
}
 
$SIG{ALRM} = sub {
  $status = query_info();
  alarm($delay); # pour la prochaine mesure
};
 
$SIG{INT} = sub {
  $status = 1;
};
 
$status = query_info();
alarm($delay); # pour la prochaine mesure
until ($status) {
  sleep(1);  # verifie toutes les secondes qu'on a pas recu ctrl-C
}

 
et modifier disp_data pour ouvrir un fichier, y ajouter les données et fermer le fichier à chaque appel.
 
A+,

C'est sympa pour le coup de main;  
Je regarde le code ce matin, et dès que j'ai avancé, je reviens ici ^^
 
Merci En tout cas

J'ai essayé de lancer le mbtget sans aucune modification, et il ne marche pas, "connexion au serveur 502 impossible", j'ai regarde à gauche et à droite, mais pas moyen de comprendre pourquoi il bug.
 
mon programme ne s'arretera pas avant plusieur mois (10 environ) et donc, un simple ctrl-C est plus simple à réaliser.
 
Je travaille le code, est dès que j'ai avancé un peu, je le copie ici.
 
merci
ju

> J'ai essayé de lancer le mbtget sans aucune modification, et il ne marche pas, "connexion au serveur 502 impossible", j'ai regarde à gauche et à droite, mais pas moyen de comprendre pourquoi il bug.  
 
 
Celui qui est la: http://source.perl.free.fr/spip.php?article2  ?
Ben alors c'est quoi le mbtget ce que vous avez employé pour faire mbtget -r3 -a 264 (adresse variable) et @IP ?
 
A+,

je l'ai télécharger sur cette page;  
 
je ne comprends pas en fait pourquoi utiliser le mbtget et modifier la boucle query_info()...
 
Parsque en fait, il faut utiliser la fonction mbtget dans mon script et créer un autre petit programme pour attendre le temps entre 2 mesures(300 s) dans le test ci-dessous. Enfin, je dois créer un programme qui va enregistrer al valeur extraite du serveur.
 
En gros, c'est ce chemin qu'il faut emprunter ^^ ??

Celui que j'ai écrit  dans cette page ici?
Et vous avez mis la bonne IP a  
$opt_server = 'votre.ip.en.chiffres';
 
A+,

oui, et il me marque une erreur :
 
Use of uninitialized value $server_ip in concatenation (.) or string at cessai.pl line 45
 
Unbale to resolve ""
 
 
 
 
#!/usr/bin/perl
 
use strict;
use warnings;
use Socket;
 
# Paramètres ModBus/TCP
my $MODBUS_PORT                                 = 502;
# Codes fonctions
my $READ_COILS                                  = 0x01;
my $READ_DISCRETE_INPUTS                        = 0x02;
my $READ_HOLDING_REGISTERS                      = 0x03;
my $READ_INPUT_REGISTERS                        = 0x04;
my $WRITE_SINGLE_COIL                           = 0x05;
my $WRITE_SINGLE_REGISTER                       = 0x06;
# Codes exceptions
my $EXP_ILLEGAL_FUNCTION                        = 0x01;
my $EXP_DATA_ADDRESS                            = 0x02;
my $EXP_DATA_VALUE                              = 0x03;
my $EXP_SLAVE_DEVICE_FAILURE                    = 0x04;
my $EXP_ACKNOWLEDGE                             = 0x05;
my $EXP_SLAVE_DEVICE_BUSY                       = 0x06;
my $EXP_MEMORY_PARITY_ERROR                     = 0x08;
my $EXP_GATEWAY_PATH_UNAVAILABLE                = 0x0A;
my $EXP_GATEWAY_TARGET_DEVICE_FAILED_TO_RESPOND = 0x0B;
 
# Valeurs par défaut
my $opt_server                                  = 'localhost';
my $opt_server_port                             = $MODBUS_PORT;
my $opt_timeout                                 = 5;
my $opt_unit_id                                 = 1;
my $opt_mb_fc                                   = $READ_HOLDING_REGISTERS;
my $opt_mb_ad                                   = 0;
my $opt_mb_nb                                   = 1;
my $opt_bit_value                               = 0;
my $opt_word_value                              = 0;
 
 
 
$opt_mb_ad = 264;
$opt_server = 192.168.1.253;
# Résolution DNS
my $server_ip = inet_aton($opt_server);
unless ($server_ip) {
  print STDERR 'unable to resolve "'.$server_ip.'"'."\n";
  exit 1;
}
 
my $status = query_info();
until ($status) {
  sleep(10);  # toutes les 10s, a adapter à ses besoins
  $status = query_info();
}
# boucle infinie, a stopper avec un kill
 
 
sub query_info {
  # *** Gestion du dialogue reseau ***
  # Ouverture de la session TCP
  socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
  unless (connect(SERVER, sockaddr_in($MODBUS_PORT, $server_ip))) {
    print STDERR 'connexion au serveur "'.$server_ip.':'.$MODBUS_PORT.'" impossible'."\n";
    return 2;
  }
   
  # Construction de la requête
  my $tx_hd_tr_id   = int(rand 65535);
  my $tx_hd_length  = 6;
  my $tx_hd_pr_id   = 0;
  my $tx_buffer = pack("nnnCCnn", $tx_hd_tr_id, $tx_hd_pr_id , $tx_hd_length, $opt_unit_id, $opt_mb_fc, $opt_mb_ad, $opt_mb_nb);
 
  # Emission de la requête
  send(SERVER, $tx_buffer, 0);
   
  # Attente d'une réponse
  unless (can_read('SERVER', $opt_timeout)) {
    close SERVER;
    print STDERR 'receive timeout'."\n";
    return 1;
  }
 
  # Réception de l'entête
  my ($rx_frame, $rx_buffer);
  recv(SERVER, $rx_buffer, 7, 0);
  $rx_frame = $rx_buffer;
 
  # Décodage de l'entête
  my ($rx_hd_tr_id, $rx_hd_pr_id, $rx_hd_length, $rx_hd_unit_id) = unpack "nnnC", $rx_buffer;
 
  # Vérifie la cohérence de l'entête
  unless (($rx_hd_tr_id == $tx_hd_tr_id) &&
      ($rx_hd_pr_id == 0) &&
      ($rx_hd_length < 256) &&
      ($rx_hd_unit_id == 1)) {
    close SERVER;
    print STDERR 'error in receive frame'."\n";
    return 1;
  }
 
  # Réception du corps du message
  recv(SERVER, $rx_buffer, $rx_hd_length-1, 0);
  $rx_frame .= $rx_buffer;
  close SERVER;
 
  # Décodage du corps du message
  my ($rx_bd_fc, $rx_body) = unpack "Ca*", $rx_buffer;
 
  # Vérification du statut d'exception
  if ($rx_bd_fc > 0x80) {
    # Affichage du code exception
    my ($rx_except_code) = unpack "C", $rx_body;
    print 'exception (code '.$rx_except_code.')'."\n";
  } else {
    ## Lecture de mot
    my ($rx_bd_bc, $rx_read_word_data) = unpack "Ca*", $rx_body;
    # Lecture d'entier de 16 bits
    my @rx_disp_data = unpack 'n*', $rx_read_word_data;
    disp_data(@rx_disp_data);
  }
  return 0;
}
 
 
 
# Attend $timeout secondes que la socket mette à disposition des données
sub can_read {
  my ($sock_handle, $timeout) = @_;
  my $hdl_select = "";
  vec($hdl_select, fileno($sock_handle), 1) = 1;
  return (select($hdl_select, undef, undef, $timeout) == 1);
}
 
 
# Affichage des valeurs reçues
sub disp_data {
  # Affichage du résultat
  # Format csv pour utilisation dans un script
  foreach (@_) {
    printf '%05d;', $_;
  }
  print "\n";
}
 
 

Je vois.
$opt_server = 192.168.1.253;  
# Résolution DNS  
my $server_ip = inet_aton($opt_server);  
unless ($server_ip) {  
  print STDERR 'unable to resolve "'.$server_ip.'"'."\n";  
  exit 1;  
}  
Remplacer avec
$opt_server = '192.168.1.253';  ## ici, ' et '
# Résolution DNS  
my $server_ip = inet_aton($opt_server);  
unless ($server_ip) {  
  print STDERR 'unable to resolve "'.$opt_server.'"'."\n"; # et la,  
  exit 1;  
}  
 
la première ligne n'est pas correctement comprise sans quote, j'en avais mis dans mon texte.
Et pour le message d'erreur, mea culpa, j'avais mis le nom de la variable vide après echec, pas celui de la variable testée.
 
A+,

La commande compile nikel,
la je vais finir de comprendre le code.
 
Il ne me reste plus qu'a faire le code pour l'export en csv ou txt et le tour sera joué pour ce premier draft ^^
 
Merci pour le coup de main
 
julien

Sinon, comme j'ai dit plus dans l'autre sujet, ça peut se transposer en C de manière directe. C'est juste un dialogue sur une socket tcp de manière complètement standard.
 
A+,

pour le programme, il est plus simple à faire et à suivre en C ou Perl ?  
je travaille depuis 1 an ou 2 en C/C++ et je ne savais pas que l'on pouvait travailler directement sur les TCP en C / C++ . . .
 
Le Perl est peut-etre plus simple à ecrire, pour ce que jai vu ici en tout cas.

>> je travaille depuis 1 an ou 2 en C/C++ et je ne savais pas que l'on pouvait travailler directement sur les TCP en C / C++ . . .  
 
D'après toi, comment fonctionne l'essentiel de la couche réseau sur les machines?
Il y a des tutoriaux partout: http://www.csd.uoc.gr/~hy556/mater [...] torial.pdf
 
La je dois m'en aller, mais c'est 30 mn pour transposer le code perl spécialisé à cette requête précise en C.
Peut être ce soir si j'ai du temps.
 
A+,

Ok, c'est cool,  
je regarde tout ça et je poserai une copie du code final su le post ce soir.
 
Merci pour le coup de main

Après modification, j'ai mis le code et il compile bien, mais comment exporter un champs précis, comme pra exemple le champs 267 de la table des datas ?
 
#!/usr/bin/perl
 
use strict;
use warnings;
use Socket;
 
# Paramètres ModBus/TCP
my $MODBUS_PORT                                 = 502;
# Codes des fonctions lecture, ecriture, ...
my $READ_COILS                                  = 0x01;
my $READ_DISCRETE_INPUTS                        = 0x02;
my $READ_HOLDING_REGISTERS                      = 0x03;
my $READ_INPUT_REGISTERS                        = 0x04;
my $WRITE_SINGLE_COIL                           = 0x05;
my $WRITE_SINGLE_REGISTER                       = 0x06;
# Codes des exceptions erreurs, ...
my $EXP_ILLEGAL_FUNCTION                        = 0x01;
my $EXP_DATA_ADDRESS                            = 0x02;
my $EXP_DATA_VALUE                              = 0x03;
my $EXP_SLAVE_DEVICE_FAILURE                    = 0x04;
my $EXP_ACKNOWLEDGE                             = 0x05;
my $EXP_SLAVE_DEVICE_BUSY                       = 0x06;
my $EXP_MEMORY_PARITY_ERROR                     = 0x08;
my $EXP_GATEWAY_PATH_UNAVAILABLE                = 0x0A;
my $EXP_GATEWAY_TARGET_DEVICE_FAILED_TO_RESPOND = 0x0B;
 
# Valeurs par défaut  
my $opt_server                                  = 'localhost';
my $opt_server_port                             = $MODBUS_PORT;  #502
my $opt_timeout                                 = 5;   # temps max de s s  
my $opt_unit_id                                 = 1;
my $opt_mb_fc                                   = $READ_HOLDING_REGISTERS;
my $opt_mb_ad                                   = 0;
my $opt_mb_nb                                   = 1;
my $opt_bit_value                               = 0;
my $opt_word_value                              = 0;
 
 
 
 
$opt_server = '192.168.1.253';       # @ IP du serveur TCP
my $server_ip = inet_aton($opt_server);      # on donne l'@ IP à la variable
unless ($server_ip) {  
  print STDERR 'unable to resolve "'.$opt_server.'"'."\n"; # et la,  
  exit 1;  
}  
 
# boucle infinie, a stopper avec >> kill    # tourne sas cesse jusqu'au ctrl+C
   
sub query_info {      
 
  # Gestion du dialogue reseau
  # Ouverture de la session TCP
 
  socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
  unless (connect(SERVER, sockaddr_in($MODBUS_PORT, $server_ip))) {
    print STDERR 'connexion au serveur "'.$server_ip.':'.$MODBUS_PORT.'" impossible'."\n";
    return 2;
  }
   
  # Création de la requête  
  my $tx_hd_tr_id   = int(rand 65535);
  my $tx_hd_length  = 6;
  my $tx_hd_pr_id   = 0;
  my $tx_buffer = pack("nnnCCnn", $tx_hd_tr_id, $tx_hd_pr_id , $tx_hd_length, $opt_unit_id, $opt_mb_fc, $opt_mb_ad, $opt_mb_nb);
 
  # Emission de la requête
  send(SERVER, $tx_buffer, 0);
   
  # Attente d'une réponse
  unless (can_read('SERVER', $opt_timeout)) {
    close SERVER;
    print STDERR 'receive timeout'."\n";
    return 1;
  }
 
  # Réception de l'entête
  my ($rx_frame, $rx_buffer);
  recv(SERVER, $rx_buffer, 7, 0);
  $rx_frame = $rx_buffer;
 
  # Décodage de l'entête
  my ($rx_hd_tr_id, $rx_hd_pr_id, $rx_hd_length, $rx_hd_unit_id) = unpack "nnnC", $rx_buffer;
 
  # Vérifie la cohérence de l'entête
  unless (($rx_hd_tr_id == $tx_hd_tr_id) &&
      ($rx_hd_pr_id == 0) &&
      ($rx_hd_length < 256) &&
      ($rx_hd_unit_id == 1)) {
    close SERVER;
    print STDERR 'error in receive frame'."\n";
    return 1;
  }
 
  # Réception du corps du message
  recv(SERVER, $rx_buffer, $rx_hd_length-1, 0);
  $rx_frame .= $rx_buffer;
  close SERVER;
 
  # Décodage du corps du message
  my ($rx_bd_fc, $rx_body) = unpack "Ca*", $rx_buffer;
 
  # Vérification du statut d'exception
  if ($rx_bd_fc > 0x80) {
 
    # Affichage du code exception
    my ($rx_except_code) = unpack "C", $rx_body;
    print 'exception (code '.$rx_except_code.')'."\n";
  }  
 
else {
 
    ## Lecture de mot
    my ($rx_bd_bc, $rx_read_word_data) = unpack "Ca*", $rx_body;
 
    # Lecture d'entier de 16 bits
    my @rx_disp_data = unpack 'n*', $rx_read_word_data;
    disp_data(@rx_disp_data);
  }
  return 0;
}
 
 
 
# Attend $timeout secondes que la socket mette à disposition des données
sub can_read {
  my ($sock_handle, $timeout) = @_;
  my $hdl_select = "";
  vec($hdl_select, fileno($sock_handle), 1) = 1;
  return (select($hdl_select, undef, undef, $timeout) == 1);
}
 
 
# Affichage des valeurs recues
sub disp_data {
   
  # Création du fichier 'cexport.txt'
open (FICHIER, "ctest.txt" ) || die ("Impossible de créer le fichier \"cexport.txt\"" );
 
  foreach (@_) {
  print FICHIER '%05d;', $_;
  }
close (FICHIER);
 
}
 
 
Mais pas de fichier créé pour l'export des datas.
Je retente un morceau de code ^^

Après de multiples essais, je n'arrive pas à extraire les données, pourtant le programme se lance et aucun fichier est exporté.
J'ai mis mon code ci-dessus hier soir et j'ai travaille dessus hier soir.
Mais rien à faire, j'essaie de comprendre pourquoi il n'y a aucun export.
 
Si quelqu'un passe par là . . .  
 
Merci

Remplacer

# Affichage des valeurs recues 
sub disp_data { 
   
  # Création du fichier 'c:/export.txt' 
open (FICHIER, "c:/test.txt" ) || die ("Impossible de créer le fichier \"c:/export.txt\"" ); 
 
  foreach (@_) { 
  print FICHIER '%05d;', $_; 
  } 
close (FICHIER); 
  
}

par

# Affichage des valeurs recues 
sub disp_data { 
   
 open(my $fh, ">>", 'C:/test.txt' ) or die ('Impossible de créer le fichier "c:/export.txt"' ); 
 
  foreach (@_) { 
  printf( $fh "%05d;", $_); 
  } 
close ($fh); 
  
}

 
A+,

J'ai bien faits els modifications, cependant, il n'y a aucun export vers le fichier test.txt.  
 
le programme compile, se lance, mais pas d'export
 
Need help  

Et en rajoutant un  
printf( $fh "\n" );  
juste avant le close($fh);
pour flusher le buffer?
 
A+,

Pareil, pas d'export,  
Le nombre de champs à exporter peut-il influencer le programme ?  

#!/usr/bin/perl
 
use strict;
use warnings;
use Socket;
 
# Paramètres ModBus/TCP
my $MODBUS_PORT                                 = 502;
 
# Codes des fonctions lecture, ecriture, ...
my $READ_COILS                                  = 0x01;
my $READ_DISCRETE_INPUTS                        = 0x02;
my $READ_HOLDING_REGISTERS                      = 0x03;
my $READ_INPUT_REGISTERS                        = 0x04;
my $WRITE_SINGLE_COIL                           = 0x05;
my $WRITE_SINGLE_REGISTER                       = 0x06;
 
# Codes des exceptions erreurs, ...
my $EXP_ILLEGAL_FUNCTION                        = 0x01;
my $EXP_DATA_ADDRESS                            = 0x02;
my $EXP_DATA_VALUE                              = 0x03;
my $EXP_SLAVE_DEVICE_FAILURE                    = 0x04;
my $EXP_ACKNOWLEDGE                             = 0x05;
my $EXP_SLAVE_DEVICE_BUSY                       = 0x06;
my $EXP_MEMORY_PARITY_ERROR                     = 0x08;
my $EXP_GATEWAY_PATH_UNAVAILABLE                = 0x0A;
my $EXP_GATEWAY_TARGET_DEVICE_FAILED_TO_RESPOND = 0x0B;
 
# Valeurs par défaut  
my $opt_server                                  = 'localhost';
my $opt_server_port                             = $MODBUS_PORT;  #502
my $opt_timeout                                 = 1;   # temps max de 1 s  
my $opt_unit_id                                 = 1;
my $opt_mb_fc                                   = $READ_HOLDING_REGISTERS;
my $opt_mb_ad                                   = 0;
my $opt_mb_nb                                   = 1;
my $opt_bit_value                               = 0;
my $opt_word_value                              = 0;
 
 
 
 
$opt_server = '192.168.1.253';       # @ IP du serveur TCP
my $server_ip = inet_aton($opt_server);      # on donne l'@ IP à la variable
unless ($server_ip) {  
  print STDERR 'unable to resolve "'.$opt_server.'"'."\n"; # et la,  
  exit 1;  
}  
 
# boucle infinie, a stopper avec un kill    # tourne sas cesse jusqu'au ctrl+C
   
sub query_info {      
 
  # Gestion du dialogue reseau
  # Ouverture de la session TCP
 
  socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
  unless (connect(SERVER, sockaddr_in($MODBUS_PORT, $server_ip))) {
    print STDERR 'connexion au serveur "'.$server_ip.':'.$MODBUS_PORT.'" impossible'."\n";
    return 2;
  }
   
  # Création de la requête  
  my $tx_hd_tr_id   = int(rand 65535);
  my $tx_hd_length  = 6;
  my $tx_hd_pr_id   = 0;
  my $tx_buffer = pack("nnnCCnn", $tx_hd_tr_id, $tx_hd_pr_id , $tx_hd_length, $opt_unit_id, $opt_mb_fc, $opt_mb_ad, $opt_mb_nb);
 
  # Emission de la requête
  send(SERVER, $tx_buffer, 0);
   
  # Attente d'une réponse
  unless (can_read('SERVER', $opt_timeout)) {
    close SERVER;
    print STDERR 'receive timeout'."\n";
    return 1;
  }
 
  # Réception de l'entête
  my ($rx_frame, $rx_buffer);
  recv(SERVER, $rx_buffer, 7, 0);
  $rx_frame = $rx_buffer;
 
  # Décodage de l'entête
  my ($rx_hd_tr_id, $rx_hd_pr_id, $rx_hd_length, $rx_hd_unit_id) = unpack "nnnC", $rx_buffer;
 
  # Vérifie la cohérence de l'entête
  unless (($rx_hd_tr_id == $tx_hd_tr_id) &&
      ($rx_hd_pr_id == 0) &&
      ($rx_hd_length < 256) &&
      ($rx_hd_unit_id == 1)) {
    close SERVER;
    print STDERR 'error in receive frame'."\n";
    return 1;
  }
 
  # Réception du corps du message
  recv(SERVER, $rx_buffer, $rx_hd_length-1, 0);
  $rx_frame .= $rx_buffer;
  close SERVER;
 
  # Décodage du corps du message
  my ($rx_bd_fc, $rx_body) = unpack "Ca*", $rx_buffer;
 
  # Vérification du statut d'exception
  if ($rx_bd_fc > 0x80) {
 
    # Affichage du code exception
    my ($rx_except_code) = unpack "C", $rx_body;
    print 'exception (code '.$rx_except_code.')'."\n";
  }  
 
else {
 
    ## Lecture de mot
    my ($rx_bd_bc, $rx_read_word_data) = unpack "Ca*", $rx_body;
 
    # Lecture d'entier de 16 bits
    my @rx_disp_data = unpack 'n*', $rx_read_word_data;
    disp_data(@rx_disp_data);
  }
  return 0;
}
 
 
 
# Attend $timeout secondes que la socket mette à disposition des données
sub can_read {
  my ($sock_handle, $timeout) = @_;
  my $hdl_select = "";
  vec($hdl_select, fileno($sock_handle), 1) = 1;
  return (select($hdl_select, undef, undef, $timeout) == 1);
}
 
 
# Affichage des valeurs recues  
 
sub disp_data {  
 
open(my $fh, ">>", 'Ctest.txt' ) || die ('Impossible de créer le fichier "ctest.txt"' );  
 
foreach (@_)  
{
  printf( $fh "%05d;", $_);
}
printf ($fh "\n" );
 
close ($fh);  
 
 
}

Parsque à aucun moment, on lui donne le champs à exporter dans le script, est-ce que sa peux venir de là ??

Et avec l'ancienne routine
# Affichage des valeurs reçues
sub disp_data {
  # Affichage du résultat
  # Format csv pour utilisation dans un script
  foreach (@_) {
    printf '%05d;', $_;
  }
  print "\n";
}  
 
ça affiche quelque chose à l'écran?
Parce que si oui, ça restreint fortement la zone des problemes.
 
A+,

Non, pas d'affichage à l'écran.
pourtant le pgm compile et se lance normalement ^^

se lance normalement, c'est à dire que il n'y a pas d'erreur sur la console.

Ah ben il aurait fallu me le dire avant, ça, que ça affichait rien.
Bon, on va rester avec cette ancienne routine d'abord.
 
après cette ligne:
 my ($rx_bd_bc, $rx_read_word_data) = unpack "Ca*", $rx_body;  
 
ajoutez  
print "fct code: $rx_bd_fc -- nb val: $rx_bd_bc\n";
 
et dites ce qui s'écrit en sortie.
 
A+,
 

En ajoutant la ligne :
>> print "fct code: $rx_bd_fc -- nb val: $rx_bd_bc\n";  
 
      my ($rx_bd_bc, $rx_read_word_data) = unpack "Ca*", $rx_body;
    print "fct code: $rx_bd_fc -- nb val: $rx_bd_bc\n";  
 
    # Lecture d'entier de 16 bits
    my @rx_disp_data = unpack 'n*', $rx_read_word_data;
    disp_data(@rx_disp_data);
 
je n'ai rien en affichage sur la console

j'ai testé avec les 2 versions du pgm :
 
ancienne routine ,
nouvelle,
 
Pas de changements

Ah ben j'ai pigé:
Dans votre code, vous avez viré ce que j'avais mis:
my $status = query_info();
until ($status) {
 sleep(10);  # toutes les 10s, a adapter à ses besoins
 $status = query_info();
}
# boucle infinie, a stopper avec un kill
 
alors évidemment, comme on n'appelle jamais query_info() on ne fait rien.
 
A+,

A bien tout de suite, quand je rajoute les lignes, j'ai bien un chiffre qui est exporté . . .  
 
Désolé pour ce temps perdu, en tout cas, c'est ma faute si j'ai perdu du temps.
 

Mauintenant, est-ce que je peux cibler la valeur sur une adresse bien spécifique ? par exemple l'adresse 267 (binaire) ou 010B (Hexa) ?
 
merci Gilou pour le coup de main c'est sympa

C'est bon, j'ai trouvé le truc pour les adresses ^^

Allez aussi voir ma réponse sur l'autre topic.
A+,

Mon export fonctionne maintenant bien (merci gilou) et
je commence a y apporter des améliorations. Je souhaite exporter d'autres champs mais sur le même fichier texte ou csv.
 
Je pense qu'il faut créer une matrice dans ce fichier et y exporter les datas. Mais comment créer cette matrice de forme 24 lignes et 5 colonnes? Lors de l'export du coup, je devrais choisir où je mets les valeurs exportées, non ?

Le plus simple:
vous créez un hash (une des grandes forces de perl, cette structure de données)
my %infos;
à chaque lecture de registre, vous stockez la valeur lue dans le hash
$infos{'conso'} = ....
lecture d'un autre registre
$infos{'conso en horaire de nuit'} = ....
et a la fin de tout ça, vous écrivez le hash sous forme d'une ligne au format csv dans le fichier.
 
A+,

Du coup, je lis mes variables dans differents champs et j'enregistre les valeurs dans le hash {h1}, {h2} ... et à la fin, pour ecrire, je peux faire un :
# Affichage des valeurs recues  
 
sub disp_data {  
 
open(my $fh, ">>", 'Ctest.csv' ) || die ('Impossible de créer le fichier "cjulien/test.csv"' );  
     foreach (@_)  
     {
          printf( $fh "%05d;", {h1}, {h2});
     }
      printf ($fh "\n" );
 
close ($fh);  
 
 
}

a quel moment du pgm, le registre est il lu et la valeur sortie  ? parsqu si je suis la logique du pgm, on envoie la requete, on attent une répone, on décode et on verifie la coherence; puis on recoit le corps du message. Enfin, on lit le mot puis on le lit en entier de 16 bits. Mais au moment de l'exporter sur le $fh, la valeur du champse trouve dans quelle variable, $_ ? du coup, pour lire plusieurs champs, je dois faire une boucle qui vont lire et après une boucle qui va enregistrer dans le hash.
 
@+