Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2462 connectés 

  FORUM HardWare.fr
  Programmation
  Perl

  [Résolu] Export données en perl

 
 


 Mot :   Pseudo :  
 
 Page :   1  2  3  4  5  6  7
Page Suivante
Page Précédente
Bas de page 
Auteur Sujet :

[Résolu] Export données en perl

n°2218878
clubber43
Posté le 07-02-2014 à 11:33:35  profilanswer
 

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
mood
Publicité
Posté le 07-02-2014 à 11:33:35  profilanswer
 

n°2218879
gilou
Modérateur
Modzilla
Posté le 07-02-2014 à 11:45:06  profilanswer
 

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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2218880
clubber43
Posté le 07-02-2014 à 11:51:47  profilanswer
 

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
n°2218907
gilou
Modérateur
Modzilla
Posté le 07-02-2014 à 16:09:29  profilanswer
 

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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2218950
gilou
Modérateur
Modzilla
Posté le 07-02-2014 à 22:08:12  profilanswer
 

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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2219083
clubber43
Posté le 10-02-2014 à 08:36:00  profilanswer
 

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

n°2219091
clubber43
Posté le 10-02-2014 à 10:11:06  profilanswer
 

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

n°2219125
gilou
Modérateur
Modzilla
Posté le 10-02-2014 à 14:34:41  profilanswer
 

> 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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2219126
clubber43
Posté le 10-02-2014 à 14:38:22  profilanswer
 

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

n°2219127
gilou
Modérateur
Modzilla
Posté le 10-02-2014 à 14:41:48  profilanswer
 

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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
mood
Publicité
Posté le 10-02-2014 à 14:41:48  profilanswer
 

n°2219130
clubber43
Posté le 10-02-2014 à 14:45:22  profilanswer
 

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";
}
 
 

n°2219135
gilou
Modérateur
Modzilla
Posté le 10-02-2014 à 14:57:40  profilanswer
 

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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2219139
clubber43
Posté le 10-02-2014 à 15:07:03  profilanswer
 

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

n°2219144
gilou
Modérateur
Modzilla
Posté le 10-02-2014 à 15:10:44  profilanswer
 

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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2219146
clubber43
Posté le 10-02-2014 à 15:12:54  profilanswer
 

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
n°2219147
gilou
Modérateur
Modzilla
Posté le 10-02-2014 à 15:26:19  profilanswer
 

>> 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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2219151
clubber43
Posté le 10-02-2014 à 15:29:27  profilanswer
 

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

n°2219164
clubber43
Posté le 10-02-2014 à 16:19:19  profilanswer
 

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

n°2219226
clubber43
Posté le 11-02-2014 à 10:02:51  profilanswer
 

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

n°2219228
gilou
Modérateur
Modzilla
Posté le 11-02-2014 à 10:36:52  profilanswer
 

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
n°2219238
clubber43
Posté le 11-02-2014 à 11:31:55  profilanswer
 

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  

n°2219250
gilou
Modérateur
Modzilla
Posté le 11-02-2014 à 14:49:52  profilanswer
 

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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2219251
clubber43
Posté le 11-02-2014 à 14:53:39  profilanswer
 

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

n°2219252
clubber43
Posté le 11-02-2014 à 14:57:28  profilanswer
 

#!/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);  
 
 
}

n°2219253
clubber43
Posté le 11-02-2014 à 14:58:05  profilanswer
 

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

n°2219255
gilou
Modérateur
Modzilla
Posté le 11-02-2014 à 15:03:23  profilanswer
 

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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2219257
clubber43
Posté le 11-02-2014 à 15:05:30  profilanswer
 

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

n°2219258
clubber43
Posté le 11-02-2014 à 15:06:53  profilanswer
 

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

n°2219260
gilou
Modérateur
Modzilla
Posté le 11-02-2014 à 15:13:09  profilanswer
 

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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2219261
clubber43
Posté le 11-02-2014 à 15:17:40  profilanswer
 


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

n°2219262
clubber43
Posté le 11-02-2014 à 15:19:08  profilanswer
 

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

n°2219263
gilou
Modérateur
Modzilla
Posté le 11-02-2014 à 15:23:07  profilanswer
 

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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2219266
clubber43
Posté le 11-02-2014 à 15:54:07  profilanswer
 

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.
 

n°2219267
clubber43
Posté le 11-02-2014 à 15:56:24  profilanswer
 

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

n°2219269
clubber43
Posté le 11-02-2014 à 16:05:22  profilanswer
 

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

n°2219273
gilou
Modérateur
Modzilla
Posté le 11-02-2014 à 16:59:29  profilanswer
 

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


---------------
There's more than what can be linked! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2219455
clubber43
Posté le 13-02-2014 à 09:41:28  profilanswer
 

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 ?

n°2219470
gilou
Modérateur
Modzilla
Posté le 13-02-2014 à 12:26:11  profilanswer
 

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! --    Iyashikei Anime Forever!    --  AngularJS c'est un framework d'engulé!  --
n°2219479
clubber43
Posté le 13-02-2014 à 13:40:50  profilanswer
 

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);  
 
 
}

n°2219488
clubber43
Posté le 13-02-2014 à 14:11:43  profilanswer
 

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

mood
Publicité
Posté le   profilanswer
 

 Page :   1  2  3  4  5  6  7
Page Suivante
Page Précédente
Haut de page 

Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  Perl

  [Résolu] Export données en perl

 

Sujets relatifs
Copier données en ligne par colonneComment génerer un fichier csv à partir d'une base de données?
perl + xml[Perl] Créer un graph RRD avec RRDTool::OO
[Résolu][Perl] XML::DOM Comment avoir une belle indentation?Programmation Java lecture base de données
[VBA-Excel] Comment appeler un fichier pour récupérer des données ?extraction de donnees
Récupération données d'un site PHPRécupérer des données d'un fichier xml
Plus de sujets relatifs à : [Résolu] Export données en perl

Forum MesDiscussions.Net, Version 2010.2
(c) 2000-2011 Doctissimo
Page générée en 0.229 secondes

Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR