[Résolu] Export données en perl

Export données en perl [Résolu] - Perl - Programmation

Marsh Posté le 07-02-2014 à 11:33:35    

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


Message édité par clubber43 le 23-06-2014 à 10:15:43
Reply

Marsh Posté le 07-02-2014 à 11:33:35   

Reply

Marsh Posté le 07-02-2014 à 11:45:06    

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+,


Message édité par gilou le 07-02-2014 à 11:45:31

---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 07-02-2014 à 11:51:47    

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

Message cité 1 fois
Reply

Marsh Posté le 07-02-2014 à 16:09:29    

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+,


---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 07-02-2014 à 22:08:12    

Code :
  1. #!/usr/bin/perl
  2.  
  3. use strict;
  4. use warnings;
  5. use Socket;
  6.  
  7. # Paramètres ModBus/TCP
  8. my $MODBUS_PORT                                 = 502;
  9. # Codes fonctions
  10. my $READ_COILS                                  = 0x01;
  11. my $READ_DISCRETE_INPUTS                        = 0x02;
  12. my $READ_HOLDING_REGISTERS                      = 0x03;
  13. my $READ_INPUT_REGISTERS                        = 0x04;
  14. my $WRITE_SINGLE_COIL                           = 0x05;
  15. my $WRITE_SINGLE_REGISTER                       = 0x06;
  16. # Codes exceptions
  17. my $EXP_ILLEGAL_FUNCTION                        = 0x01;
  18. my $EXP_DATA_ADDRESS                            = 0x02;
  19. my $EXP_DATA_VALUE                              = 0x03;
  20. my $EXP_SLAVE_DEVICE_FAILURE                    = 0x04;
  21. my $EXP_ACKNOWLEDGE                             = 0x05;
  22. my $EXP_SLAVE_DEVICE_BUSY                       = 0x06;
  23. my $EXP_MEMORY_PARITY_ERROR                     = 0x08;
  24. my $EXP_GATEWAY_PATH_UNAVAILABLE                = 0x0A;
  25. my $EXP_GATEWAY_TARGET_DEVICE_FAILED_TO_RESPOND = 0x0B;
  26.  
  27. # Valeurs par défaut
  28. my $opt_server                                  = 'localhost';
  29. my $opt_server_port                             = $MODBUS_PORT;
  30. my $opt_timeout                                 = 5;
  31. my $opt_unit_id                                 = 1;
  32. my $opt_mb_fc                                   = $READ_HOLDING_REGISTERS;
  33. my $opt_mb_ad                                   = 0;
  34. my $opt_mb_nb                                   = 1;
  35. my $opt_bit_value                               = 0;
  36. my $opt_word_value                              = 0;
  37.  
  38.  
  39.  
  40. $opt_mb_ad = 264;
  41. $opt_server = 'votre.ip.en.chiffres';
  42. # Résolution DNS
  43. my $server_ip = inet_aton($opt_server);
  44. unless ($server_ip) {
  45.   print STDERR 'unable to resolve "'.$server_ip.'"'."\n";
  46.   exit 1;
  47. }
  48.  
  49. my $status = query_info();
  50. until ($status) {
  51.   sleep(10);  # toutes les 10s, a adapter à ses besoins
  52.   $status = query_info();
  53. }
  54. # boucle infinie, a stopper avec un kill
  55.  
  56.  
  57. sub query_info {
  58.   # *** Gestion du dialogue reseau ***
  59.   # Ouverture de la session TCP
  60.   socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
  61.   unless (connect(SERVER, sockaddr_in($MODBUS_PORT, $server_ip))) {
  62.     print STDERR 'connexion au serveur "'.$server_ip.':'.$MODBUS_PORT.'" impossible'."\n";
  63.     return 2;
  64.   }
  65.   
  66.   # Construction de la requête
  67.   my $tx_hd_tr_id   = int(rand 65535);
  68.   my $tx_hd_length  = 6;
  69.   my $tx_hd_pr_id   = 0;
  70.   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);
  71.  
  72.   # Emission de la requête
  73.   send(SERVER, $tx_buffer, 0);
  74.   
  75.   # Attente d'une réponse
  76.   unless (can_read('SERVER', $opt_timeout)) {
  77.     close SERVER;
  78.     print STDERR 'receive timeout'."\n";
  79.     return 1;
  80.   }
  81.  
  82.   # Réception de l'entête
  83.   my ($rx_frame, $rx_buffer);
  84.   recv(SERVER, $rx_buffer, 7, 0);
  85.   $rx_frame = $rx_buffer;
  86.  
  87.   # Décodage de l'entête
  88.   my ($rx_hd_tr_id, $rx_hd_pr_id, $rx_hd_length, $rx_hd_unit_id) = unpack "nnnC", $rx_buffer;
  89.  
  90.   # Vérifie la cohérence de l'entête
  91.   unless (($rx_hd_tr_id == $tx_hd_tr_id) &&
  92.       ($rx_hd_pr_id == 0) &&
  93.       ($rx_hd_length < 256) &&
  94.       ($rx_hd_unit_id == 1)) {
  95.     close SERVER;
  96.     print STDERR 'error in receive frame'."\n";
  97.     return 1;
  98.   }
  99.  
  100.   # Réception du corps du message
  101.   recv(SERVER, $rx_buffer, $rx_hd_length-1, 0);
  102.   $rx_frame .= $rx_buffer;
  103.   close SERVER;
  104.  
  105.   # Décodage du corps du message
  106.   my ($rx_bd_fc, $rx_body) = unpack "Ca*", $rx_buffer;
  107.  
  108.   # Vérification du statut d'exception
  109.   if ($rx_bd_fc > 0x80) {
  110.     # Affichage du code exception
  111.     my ($rx_except_code) = unpack "C", $rx_body;
  112.     print 'exception (code '.$rx_except_code.')'."\n";
  113.   } else {
  114.     ## Lecture de mot
  115.     my ($rx_bd_bc, $rx_read_word_data) = unpack "Ca*", $rx_body;
  116.     # Lecture d'entier de 16 bits
  117.     my @rx_disp_data = unpack 'n*', $rx_read_word_data;
  118.     disp_data(@rx_disp_data);
  119.   }
  120.   return 0;
  121. }
  122.  
  123.  
  124.  
  125. # Attend $timeout secondes que la socket mette à disposition des données
  126. sub can_read {
  127.   my ($sock_handle, $timeout) = @_;
  128.   my $hdl_select = "";
  129.   vec($hdl_select, fileno($sock_handle), 1) = 1;
  130.   return (select($hdl_select, undef, undef, $timeout) == 1);
  131. }
  132.  
  133.  
  134. # Affichage des valeurs reçues
  135. sub disp_data {
  136.   # Affichage du résultat
  137.   # Format csv pour utilisation dans un script
  138.   foreach (@_) {
  139.     printf '%05d;', $_;
  140.   }
  141.   print "\n";
  142. }


 
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:

Code :
  1. my $status;
  2. my $delay = 300; # une mesure toutes les 5 mn
  3.  
  4. # pour le test
  5. sub query_info() {
  6.   print "lecture des valeurs \n";
  7.   return 0;
  8. }
  9.  
  10. $SIG{ALRM} = sub {
  11.   $status = query_info();
  12.   alarm($delay); # pour la prochaine mesure
  13. };
  14.  
  15. $SIG{INT} = sub {
  16.   $status = 1;
  17. };
  18.  
  19. $status = query_info();
  20. alarm($delay); # pour la prochaine mesure
  21. until ($status) {
  22.   sleep(1);  # verifie toutes les secondes qu'on a pas recu ctrl-C
  23. }


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


Message édité par gilou le 08-02-2014 à 14:11:52

---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 10-02-2014 à 08:36:00    

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

Reply

Marsh Posté le 10-02-2014 à 10:11:06    

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

Reply

Marsh Posté le 10-02-2014 à 14:34:41    

> 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+,


Message édité par gilou le 10-02-2014 à 14:35:55

---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 10-02-2014 à 14:38:22    

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 ^^ ??

Reply

Marsh Posté le 10-02-2014 à 14:41:48    

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


Message édité par gilou le 10-02-2014 à 14:42:05

---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 10-02-2014 à 14:41:48   

Reply

Marsh Posté le 10-02-2014 à 14:45:22    

oui, et il me marque une erreur :
 
Use of uninitialized value $server_ip in concatenation (.) or string at c:/essai.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";
}
 
 

Reply

Marsh Posté le 10-02-2014 à 14:57:40    

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+,


---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 10-02-2014 à 15:07:03    

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

Reply

Marsh Posté le 10-02-2014 à 15:10:44    

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+,


---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 10-02-2014 à 15:12:54    

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.

Message cité 1 fois
Reply

Marsh Posté le 10-02-2014 à 15:26:19    

>> 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+,


---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 10-02-2014 à 15:29:27    

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

Reply

Marsh Posté le 10-02-2014 à 16:19:19    

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 'c:/export.txt'
open (FICHIER, "c:/test.txt" ) || die ("Impossible de créer le fichier \"c:/export.txt\"" );
 
  foreach (@_) {
  print FICHIER '%05d;', $_;
  }
close (FICHIER);
 
}
 
 
Mais pas de fichier créé pour l'export des datas.
Je retente un morceau de code ^^

Reply

Marsh Posté le 11-02-2014 à 10:02:51    

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 :/

Reply

Marsh Posté le 11-02-2014 à 10:36:52    

Remplacer

Code :
  1. # Affichage des valeurs recues 
  2. sub disp_data { 
  3.    
  4.   # Création du fichier 'c:/export.txt' 
  5. open (FICHIER, "c:/test.txt" ) || die ("Impossible de créer le fichier \"c:/export.txt\"" ); 
  6.  
  7.   foreach (@_) { 
  8.   print FICHIER '%05d;', $_; 
  9.   } 
  10. close (FICHIER); 
  11.   
  12. }


par

Code :
  1. # Affichage des valeurs recues 
  2. sub disp_data { 
  3.    
  4.  open(my $fh, ">>", 'C:/test.txt' ) or die ('Impossible de créer le fichier "c:/export.txt"' ); 
  5.  
  6.   foreach (@_) { 
  7.   printf( $fh "%05d;", $_); 
  8.   } 
  9. close ($fh); 
  10.   
  11. }


 
A+,


Message édité par gilou le 11-02-2014 à 10:39:12
Reply

Marsh Posté le 11-02-2014 à 11:31:55    

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  

Reply

Marsh Posté le 11-02-2014 à 14:49:52    

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


---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 11-02-2014 à 14:53:39    

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

Reply

Marsh Posté le 11-02-2014 à 14:57:28    

#!/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, ">>", 'C:/test.txt' ) || die ('Impossible de créer le fichier "c:/test.txt"' );  
 
foreach (@_)  
{
  printf( $fh "%05d;", $_);
}
printf ($fh "\n" );
 
close ($fh);  
 
 
}

Reply

Marsh Posté le 11-02-2014 à 14:58:05    

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

Reply

Marsh Posté le 11-02-2014 à 15:03:23    

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+,


---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 11-02-2014 à 15:05:30    

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

Reply

Marsh Posté le 11-02-2014 à 15:06:53    

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

Reply

Marsh Posté le 11-02-2014 à 15:13:09    

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+,
 


---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 11-02-2014 à 15:17:40    


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

Reply

Marsh Posté le 11-02-2014 à 15:19:08    

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

Reply

Marsh Posté le 11-02-2014 à 15:23:07    

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+,


---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 11-02-2014 à 15:54:07    

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.
 

Reply

Marsh Posté le 11-02-2014 à 15:56:24    

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

Reply

Marsh Posté le 11-02-2014 à 16:05:22    

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

Reply

Marsh Posté le 11-02-2014 à 16:59:29    

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


---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 13-02-2014 à 09:41:28    

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 ?

Reply

Marsh Posté le 13-02-2014 à 12:26:11    

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+,


Message édité par gilou le 13-02-2014 à 12:26:41

---------------
There's more than what can be linked! --  Le capitaine qui ne veut pas obéir à la carte finira par obéir aux récifs. -- Il ne faut plus dire Sarkozy, mais Sarkozon -- (╯°□°)╯︵ ┻━┻
Reply

Marsh Posté le 13-02-2014 à 13:40:50    

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, ">>", 'C:/test.csv' ) || die ('Impossible de créer le fichier "c:/julien/test.csv"' );  
     foreach (@_)  
     {
          printf( $fh "%05d;", {h1}, {h2});
     }
      printf ($fh "\n" );
 
close ($fh);  
 
 
}

Reply

Marsh Posté le 13-02-2014 à 14:11:43    

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.
 
@+

Reply

Marsh Posté le    

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed