Perl

[Résolu] Export données en perl

Recherche :

Mot : Pseudo : Filtrer
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

clubber43

Reprise du message précédent :
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.

@+

Publicité

gilou

Modérateur
Modzilla

Je te réponds dans une heure.
A+,

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

ok, merci beaucoup,
Je fais un peu de code et je le post.

merci bien

clubber43

#!/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 = 267; # adresse du mot1 à lire et exporter
my $opt_mb_ad2 = 305; # adresse du mot2 à lire et exporter
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;
}

my $status = query_info();
until ($status) {
sleep(1); # toutes les 1s, a adapter à ses besoins
$status = query_info();
}

# 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 le socket mette à disposition des données
sub can_read {
my $infos{conso_P}=0 ;
my ($sock_handle, $timeout) ={conso_P}= ;
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 {
my $infos ;
foreach (@_)
{
print ("$infos{{conso_P}=} = {conso_P} " );
}
}
par exemple pour un hash ?

gilou

Modérateur
Modzilla

C'est ce bout la qui correspond a une requête avec lecture de la réponse.

# 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;

On va donc le remplacer par une boucle:
avec une liste des adresses a interroger sur laquelle on boucle
my @adresses = qw(267 305);
et un hash pour les réponses
my %result;

Code :

my @adresses = qw(267 305);
my %result;
 
foreach (@adresses) {   ####
   $opt_mb_ad = $_;      ####
# 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 
    # un seul registre a lire d'ou le 'n'
    $result{$opt_mb_ad} = unpack 'n', $rx_read_word_data; ####
    }
} # fin de la boucle foreach  ####
#impression en console
foreach (sort {$a <=> $b} (keys %result)) {
    print "<$_> : $result{$_};"
}
print "\n";

Routine d'impression à adapter pour une écriture fichier, le format que tu veux, etc.
Comme tu vois, pour la boucle de requêtes, il y a très peu de modifications (visibles avec le ####): 4 lignes seulement.
A+,

Message édité par gilou le 13-02-2014 à 16:44:34

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

C'est sympa pour le coup demain.
En fait, contrairement au C, on peut passer plusieurs éléments en parametres et grâce à la boucle foreach (@adresses) { ####;
on peut faire pas mal de choses ^^

Le hash, permet en fait de rapporter plusieurs valeurs dans une seule variable si j'ai bien compris. C'est quand même pas mal comparé au C ou C++

clubber43

j'ai refais un bout de pgm pour l'export, mais j'ai comme erreurs :
send () on closed socket server at c line 84
Use of uninitialized value in vec at c line 149

Code :

#!/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                                   = 267; # adresse du mot1 à lire et exporter
  my $opt_mb_ad2                                  = 305; # adresse du mot2 à lire et exporter
  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;  
  }  
 
  my $status = query_info(); 
  until ($status) { 
  sleep(1);  # toutes les 1s, a adapter à ses besoins 
  $status = query_info(); 
  } 
# 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;
  }
  
  my @adresses = qw(267 305);
  my %result;
 
  foreach (@adresses) {   ####
  $opt_mb_ad = $_;      ####
# 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 
# un seul registre a lire d'ou le 'n'
    $result{$opt_mb_ad} = unpack 'n', $rx_read_word_data; ####
    }
    }
 # fin de la boucle foreach  ####
 # impression en console
 
  foreach (sort {$a <=> $b} (keys %result)) {
  print "<$_> : $result{$_};"
}
 print "\n";
 
########################" attente $timeout###################################
  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:/julien/test.csv' ) || die ('Impossible de créer le fichier "c:/julien/test.csv"' ); 
 
 foreach (@_) 
 {
  printf( $fh "%05d;", $_);
 }
 printf ($fh "\n" );
 
close ($fh); 
 
 
}
 
}

Je ne vois pas où se situe l'erreur.
J'ai refais un bout pour l'export en csv ou txt, et aussi déclarer la sub can_read qui manquait. Mais c'est peut-etre faux ^^

@ tento

Message édité par gilou le 14-02-2014 à 12:08:35

gilou

Modérateur
Modzilla

L'erreur est a la ligne 114:
close SERVER;
il faut la mettre après la fin de la nouvelle boucle foreach.

Pour le can_read, c'est normal, je t'ai donné un bout de code modifié hier, c'est à toi de l'insérer dans l'ancien code.

A+,

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

#!/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 = 267; # adresse du mot1 à lire et exporter
my $opt_mb_ad2 = 305; # adresse du mot2 à lire et exporter
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;
}

my $status = query_info();
until ($status) {
sleep(1); # toutes les 1s, a adapter à ses besoins
$status = query_info();
}
# 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;
}

my @adresses = qw(267 305);
my %result;

foreach (@adresses) { ####
$opt_mb_ad = $_; ####
# 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;

# 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
# un seul registre a lire d'ou le 'n'
$result{$opt_mb_ad} = unpack 'n', $rx_read_word_data; ####
}
}
close SERVER;
# fin de la boucle foreach ####
# impression en console

foreach (sort {$a <=> $b} (keys %result)) {
print "<$_> : $result{$_};"
}
print "\n";

########################" attente $timeout###################################
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.csv' ) || die ('Impossible de créer le fichier "ctest.csv"' );

foreach (@_)
{
printf( $fh "%05d;", $_);
}
printf ($fh "\n" );

close ($fh);

}

}
J'ai fais la modification sur les boucles sur-read et sur la boucle d'écriture dans le fichier, mais pas d'export en csv. Le script se lance sans probleme de compilation. Il y a surement un souci sur la ligne sub_read à mon avis ? non ?

@+

gilou

Modérateur
Modzilla

Ca n'a aucune raison de marcher, puisque c'est faux!

La dernière accolade fermante, elle doit être après le print "\n"; afin de clore la procédure query info avant qu'on définisse les autres.

et rajouter disp_data alors qu'on ne l'appelle pas dans le code, c'est normal que ça ne fasse rien.

La, le code qui va adfficher les infos en console est ici:
foreach (sort {$a <=> $b} (keys %result)) {
print "<$_> : $result{$_};"
}
print "\n";

vous pouvez remplacer ça par un
disp_data(%result);

et écrire une procédure disp_data qui fasse le travail, pour un hash et non un array.

A+,

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

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

Publicité

clubber43

Ok, je refais le bout de programme et si jamais sa marche (ou pas) je reviens sur le post.

Sinon, un bon weekend et une bonne fin d'après-midi

Julien

clubber43

Et voila après modif :

#!/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 = 267; # adresse du mot1 à lire et exporter
my $opt_mb_ad2 = 305; # adresse du mot2 à lire et exporter
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;
}

my $status = query_info();
until ($status) {
sleep(1); # toutes les 1s, a adapter à ses besoins
$status = query_info();
}
# 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;
}

my @adresses = qw(267 375 15 64);
my %result;

foreach (@adresses) { ####
$opt_mb_ad = $_; ####
# 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;

# 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
# un seul registre a lire d'ou le 'n'
$result{$opt_mb_ad} = unpack 'n', $rx_read_word_data; ####
}
}
close SERVER;
# fin de la boucle foreach ####
# impression en console

foreach (sort {$a <=> $b} (keys %result)) {
print "<$_> : $result{$_};"
}
print "\n";

########################" attente $timeout###################################
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.csv' ) || die ('Impossible de créer le fichier "ctest.csv"' );
{
printf( $fh "$result{_$}"{$_} for (keys %result));
}

close ($fh); }
}

Il me dit :

variable %result will not stay shared
Syntax error near "$result{$_}"

Je suis d'un ennui avec toutes mes questions ^^

merci

gilou

Modérateur
Modzilla

déjà

sub disp_data {

open(my $fh, ">>", 'C:/test.csv' ) || die ('Impossible de créer le fichier "c:/test.csv"' );
{
printf( $fh "$result{_$}" {$_} for (keys %result));
}

close ($fh); }
}

Faudrait peut être arrêter d’écrire n'importe quoi en priant pour que ça marche et ouvrir un peu un manuel de perl.

Code :

sub disp_data {  
  my %result = @_;
 
  open(my $fh, ">>", 'C:/test.csv' ) || die ('Impossible d\'ouvrir le fichier "c:/test.csv"' );  
  print $fh "$_;$result{$_};" foreach (keys %result)); 
  print $fh, "\n";
  close ($fh);
}

ça devrait le faire, avec un appel disp_data(%result); a mettre la ou il faut.

A+,

Message édité par gilou le 14-02-2014 à 18:02:04

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

OK,

c'est pas que j'écrit n'importe quoi, mais c'est assez dur de progresser sans faire de faute. Là, je me donne encore un peu de temps pour y arriver ^^ je comprends le code, et après, j'essaie de faire un autre pgm !!

merci gilou

clubber43

Après plusieur essais, j'ai essayé de voir pourquoi cela ne marchais pas, et j'ai aussi une erreur,
Lors du script :
- Syntax error line163 near $results{$_} " for "
- Variable %results will not stay shared at line 163

Et voilà le code.

#!/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 = 267; # adresse du mot1 à lire et exporter
my $opt_mb_ad2 = 305; # adresse du mot2 à lire et exporter
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;
}

my $status = query_info();
until ($status) {
sleep(1); # toutes les 1s, a adapter à ses besoins
$status = query_info();
}
# 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;
}

my @adresses = qw(267 305);
my %result;

foreach (@adresses) { ####
$opt_mb_ad = $_; ####
# 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;

# 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
# un seul registre a lire d'ou le 'n'
$result{$opt_mb_ad} = unpack 'n', $rx_read_word_data; ####
}
}
close SERVER;
# fin de la boucle foreach ####
# impression en console

foreach (sort {$a <=> $b} (keys %result)) {
print "<$_> : $result{$_};"

}
print "\n";

########################" attente $timeout###################################
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 {
my %result = @_;
open(my $fh, ">>", 'Ctest.csv' ) || die ('Impossible d\'ouvrir le fichier "ctest.csv"' );
print $fh "$_;$result{$_};" foreach (keys %result));
print $fh, "\n";
close ($fh);
}

}

clubber43

PS,
cela fait 15 jours que je n'ai pas pu refaire du code (deplacement etranger) du coup, j'ai eu le temps d'y regarder dans l'avion et le weekend ^^

Merci pour le coup de main

Ju

clubber43

Bon, j'ai resolu ms soucis, et du coup j'ai avancé le projet.

A l'instant t, je veux maintenant exporter ces datas vers une base de données en SQL sur un serveur distant. J'ai créé une bdd avec MySql et je suis en train de chercher pour exporter mes valeurs jusqu'à cette base de données.

J'ai vu que l'on pouvait exporter ces datas à partir de requetes sql à partir d'un code en Perl. Deja, est-ce que j'ai juste, à savoir si l'on peux exporter ces datas avec les différents codes, et ensuite, si quelqu'un peux me donner un truc ou deux, je travaille de mon coté, mais je ne dis pas non contre un peu d'aide ^^

merci

ju

gilou

Modérateur
Modzilla

Pour interfacer Perl avec une BDD, rien de plus simple, il faut utiliser les modules DBI. http://dbi.perl.org/
C'est particulièrement simple et puissant.
A+,

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

Ok, je regarde tout ça.

Merci gilou

clubber43

Dans les docs, il parle beaucoup de Oracle mais peu de MySQL, je pense que les architectures sont semblables, et que je peux utiliser ça pour mes BdD MySQL du coup ?

@+

clubber43

En cherchant sur les forums, j'ai trouvé ce genre de script.
Je l'ai compilé à ma sauce, mais je ne vois pas trop comment je peux voir les data de ma base de données. :

#!/usr/bin/perl -w
use strict;
use DBI;

print "Content-type: text/html\n\n";

# Set up variables for the connection
my $server_name = 'localhost';
my $server_ip = '127.0.0.1:3306';
my $database_name = '';
my $database_user = 'root';
my $database_pass = 'admin';

my $DSN = 'driver={SQL Server};server=$server_name;tcpip=$server_ip;database=$database_name;uid=$database_user;pwd=$database_pass;';
my $dbh = DBI->connect("dbi:ODBC:$DSN" ) || die "Couldn't open database: $DBI::errstr\n";

# Prepare the SQL query for execution
my $SQL1 = $dbh->prepare(<<End_SQL) || die "Couldn't prepare statement: $DBI::errstr\n";
select * FROM Test_Table
End_SQL

print '<table border="0" width="100%" cellpadding="0" cellspacing="0" bgcolor="#ffffff" summary=""><tr><td align="center">';
print '<table border="1" cellpadding="5" cellspacing="0" bgcolor="#ffffff" summary="">';

# Execute the query
$SQL1->execute() || die "Couldn't execute statement: $DBI::errstr\n";

# Fetch each row and print it
while ( my ($field1,$field2,$field3,$field4,$field5) = $SQL1->fetchrow_array() )
{
print "<tr><td>$field1</td><td>$field2</td><td>$field3</td><td>$field4</td><td>$field5</td></tr>";
}

print "</table></td></tr></table>";

# Disconnect from the database
$dbh->disconnect();

gilou

Modérateur
Modzilla

Ben après la query, les data sont récupérées en faisant $SQL1->fetchrow_array() c'est clair au vu du source.

A+,

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

Ok, en fait je créé la connection avec la BDD puis, on prepare la requete et enfin, on l'envoie et on ferme l'acces a la BdD (disconnect).

c'est un peu comme le progm précedent qaund on faisait une requete sur le serveur de données (compteur) et que l'on faisait un affichage de ces valeurs. Je commence à comprendre lol

+

gilou

Modérateur
Modzilla

>> Ok, en fait je créé la connection avec la BDD puis, on prepare la requete et enfin, on l'envoie
Puis on récupère les résultats (ligne à ligne en bouclant) et on les exploite
>> et on ferme l'acces a la BdD (disconnect).

Oui, c'est une logique simple et standard.

A+,

Message édité par gilou le 07-03-2014 à 13:14:48

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

Lorsque je lance le script, la fenetre me renvoie une erreur, de

DBI Connect <....> failed unkown database at c . . .
connexion impossible à la bdd.

Ou faut-il placer la bdd pour que le script puisse l ouvrir ?

++

gilou

Modérateur
Modzilla

Ben déjà c'est quoi ta base de donnée? et elle est en local?

A+,

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

c'est une base que j'ai créé en mysql et je souhaite la mettre en local avec Apache. j'ai installé apache sur mon pc et lorsque je le demarre, je peux aller sur la page http: localhost et sa m'affiche, bienvenue sur apache, .... de la pub ...

Je pense qu'il faut que je créé un dossier (www) dans le repertoire apache et que j'y mette tous les fichiers en .html, php, ... mais quid des fichier en .SQL

@

gilou

Modérateur
Modzilla

Ben il va falloir que tu fasses quelque chose comme:

#!/usr/bin/perl

use strict;
use warnings; -w
use DBI;

my $host = 'localhost'; # ou '127.0.0.1'
my $port = 3306;
my $database = 'test'; # le nom de ta bdd
my $dsn = "DBI:mysql:database=$database;host=$host;port=$port";

my $user = 'root'; # pas une très bonne idée, ça, mais bon...
my $auth = 'admin';
my $dbh = DBI->connect($dsn, $user, $auth) || die "Database connection not made: $DBI::errstr";

.....

Edit: Mais je ne comprends pas ton dernier commentaire:
- Soit tu interroges la BDD MySQL directement avec un module perl DBI
- Soit tu interroges la BDD a travers Apache, mais il faut qu'il y ait des configurations spécifiques de modules en niveau de Apache pour qu'il interroge ta BDD (qui de toute façon, est toujours présente à priori [je suis pas spécialiste Apache, donc je ne sais pas s'il intègre directement une fonctionnalité BDD mais ce n'était pas la cas autrefois]), et dans ce cas la la réponse va te revenir sous forme d'une page html qu'il faudra que tu parses.

A+,

Message édité par gilou le 07-03-2014 à 14:43:59

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

OK,
je garde la même philosophe que pour le script précédent, et je refait le bout du pgrm avec connection, requete, ...

Merci bien pour le coup de main

gilou

Modérateur
Modzilla

cf mon edit.
A+,

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

J'ai saisis.

En fait, je vais utiliser exclusivement le PERL pour lire mes valeurs dans le compteur et l'exporter via les requetes dans la BdD SQL que j'ai créé.

Apache est utilisé pour un autre application. J'ai un peu mélangé les affaires.

Merci et bon weekend,
je travailelrais un plus cela ce soir à tete reposée.

@+

Pour lire les valeurs, j'utilise le module DBI qui me

clubber43

Voila un bout de code pour créer une BDD energie :

#!/usr/bin/perl

use strict;
use warnings; -w
use DBI;

my $dbh = DBI->connect(dbi:mysql:cours", 'scott', 'tiger');

#creation table ->energie<-

$dbh->do ("create table energie(
id_compteur number(10) not null primary key,
puissance_P number(10),
puissance_Q number(10),
courant_In number (10),
time timestamp(20))" ) or die "Probleme creation table::$DBI::errstr";

#preparation
my $ins = $dbh->prepare("insert into energie values(1,2,3,4,5)" );

my $compteur=0;

print " Entrez une valeur, terminez par Ctr-D \n";

while (my $lugne = <> )
{
my ($puissance_P, $puissance_Q) = split (/\ t/, $ligne);

#Execution
$ins->execute($compteur, $puissance_P, $puissance_Q) or die "pb à l insertion";
$compteur++;
}

$ins->finish;
$dbh-> disconnect;

J'ai des erreurs de compils, mais j'ai retourné le probleme et je ne comprend pas forcement les erreurs . . .

Merci de m'aider ^^

clubber43

Pour la lecture, j'ai codé un bout aussi et installer le script dbi-lib.pl

#!/usr/bin/perl
require "cgi-lib.pl";

# précise qu'il faut utiliser DBI
eval('use DBI;');

# défini dans quel répertoire est le BDD
$dbase_dir = "/www/energie";

# permet de spécifier le content type
print &PrintHeader;

# je spécifie ma requete en SQL normal
$sql_liste_compteur = "select id_compteur, nom_compteur from categori order by nom_ccompteur";

# J'effectue la connexion DB et si ca ne marche pas j'imprime un message d'erreur
my $dbh = DBI->connect("DBI:XBase:$dbase_dir" )
or print "Connection a la DB impossible\n";

# en utilisant mon identifiant de la connexion, je prépare la requete
# SQL a effectuer. En cas d'erreur d'imprime un message
my $sth = $dbh->prepare($sql_liste_compteur)
or print "prepare error : $dbh->errstr()";

# On va maintenant exécuter a proprement parler la requete SQL
$sth->execute() or print "execute error : $sth->errstr()";
$premier=1;

# $sth->fetchrow_array permet de récupérer 1 par 1 les différents
# enregistrements trouvés par la requete SQL.
# On copie le contenu de l'enregistrement dans le tableau @catégories
while (@categories = $sth->fetchrow_array)
{
# le if sert uniquement a afficher un titre si c'est notre premier
# passage dans la boucle
if ($premier == 1)
{ print "<hr>Liste des catégories : <br><br>\n";
$premier = 0;
}
# je récupères la valeur des champs de cet enregistrement. Les
# champs sont stockés dans le tableau, dans le même ordre que
# ce que la requete SQL a indiqué.
# $categories[0] contient donc id_compteur
# $categories[1] contient donc nom_ccompteur
($id_compteur, $nom_compteur) = @categories;

# Il ne reste plus qu'a les imprimer à l'écran
print <<ENDHTML;
$id_cat : $nom_caompteur<br>
ENDHTML

}

# on se déconnecte
$dbh->disconnect;

Et là, je retrouve des erreurs de compil . . .

@+

clubber43

Bon, j'ai refaits un morceau de code et j'ai des erreurs du type :
Can't find string terminator at line 28,
Malformed UTF-8 Character byte 0x20 at line 19 19 24 24 27

Code :

#!/usr/bin/perl 
use warnings; 
use strict; 
use Encode; 
use utf8; 
use DBI;            # Charger le module DBI 
 
 
ActiverAccents(); 
 
# Paramètres de connection à la base de données 
my $bd        = 'Energie'; 
my $serveur    = 'localhost'; # @ IP IP 
my $identifiant = 'root';      # identifiant  
my $motdepasse    = 'admin'; 
my $port    = '';        #Si vous ne savez pas, ne rien mettre 
 
# Connection à la base de données mysql 
print "Connexion à la base de données $bd\n"; 
my $dbh = DBI->connect( "DBI:mysql:database=$bd;host=$serveur;port=$port",  
    $identifiant, $motdepasse, {  
    RaiseError => 1, 
    }   
) or die "Connection impossible à la base de données $bd !\n $! \n $@\n$DBI::errstr"; 
 
# Création des tables 
print "Création de la table COMPTEUR\n"; 
my $sql_creation_table_compteur = <<"SQL"; 
  id_compteur    INT             NOT NULL , 
  emplacement      VARCHAR( 10 )   NOT NULL , 
  batiment    VARCHAR( 10 )   NOT NULL , 
  niveau     VARCHAR( 10 )   NOT NULL , 
  PRIMARY KEY ( id_compteur ) 
)  COMMENT = 'COMPTEUR'; 
SQL 
 
$dbh->do('DROP TABLE IF EXISTS compteur;') or die "Impossible de supprimer la table compteur\n\n"; 
$dbh->do($sql_creation_table_compteur) or die "Impossible de créer la table compteur\n\n"; 
 
print "Création de la table Releves\n"; 
my $sql_creation_table_releves = <<"SQL"; 
CREATE TABLE releves ( 
  id_compteur      INT               NOT NULL  AUTO_INCREMENT PRIMARY KEY COMMENT 'Elle sera générée automatiquement.', 
  puissance_p      INT          NOT NULL , 
  puissance_q      INT          NOT NULL ,
  courant_I      INT          NOT NULL ,  
) COMMENT = 'COMPTEUR'; 
SQL 
 
$dbh->do('DROP TABLE IF EXISTS releves;') or die "Impossible de supprimer la table releves\n\n"; 
$dbh->do($sql_creation_table_releves) or die "Impossible de créer la table releves\n\n"; 
 
 
# Insertion des données 
my $requete_sql_compteur = <<"SQL"; 
  INSERT INTO rcompteur ( id_compteur, emplacement, batiment, niveau) 
  VALUES ( 1, TDD1, D, 1); 
SQL 
 
close $fh_regions; 
 
 
# Déconnection de la base de données 
$dbh->disconnect(); 
 
 
sub ActiverAccents { 
    my $encodage; 
    # Windows 
      if ( lc($^O ) eq 'mswin32') { 
    eval { 
        my ($codepage) = ( `chcp` =~ m/:\s+(\d+)/ ); 
        $encodage = "cp$codepage"; 
        foreach my $h ( \*STDOUT, \*STDERR, \*STDIN, ) { 
        binmode $h, ":encoding($encodage)"; 
        } 
    }; 
    } 
    else { 
    $encodage = `locale charmap`; 
    eval { 
        foreach my $h ( \*STDOUT, \*STDERR, \*STDIN, ) { 
        binmode $h, ":encoding($encodage)"; 
        } 
    }; 
    } 
  return $encodage; 
}

Message édité par gilou le 11-03-2014 à 20:19:33

clubber43

Personne pour me sortir de mon chantier :ange:

J'ai reussi à trouver un tuto pour les script en PERl mais rien qui ne repond aux erreurs ci dessus . . .

@+

gilou

Modérateur
Modzilla

> Malformed UTF-8 Character byte 0x20 at line 19 19 24 24 27
Ben tes erreurs viennent de ce que tu as des é accentués sans être sous un éditeur en utf-8 pour les saisir.
A+,

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

Alors ça, c'est une erreur c** . . .

Parcontre, pour le cant find string, c'est aussi une erreur du même niveau ^^ OU alors un peu plus poussé ?

MErci gilou

gilou

Modérateur
Modzilla

L'autre erreur, c'est parce que ton SQL terminal est suivi d'un blanc.
Or il doit être exactement identique a ce qui était dans le <<"...";
Donc enlèves ce blanc (en laissant le blanc et en remplaçant <<"SQL"; par <<"SQL "; ça marchera aussi mais ce n'est pas une bonne solution)
A+,

Message édité par gilou le 11-03-2014 à 22:10:12

---------------
There's more than what can be linked! -- Iyashikei Anime Forever! -- AngularJS c'est un framework d'engulé! --

clubber43

A ok,
je refaits le script ce matin et je le posterais après ^^

Merci
@+

clubber43

C'est parfait, je n'ai plus d'erreur de compilation,
Du coup mon script tourne, il me retse juste une erreur de : DBI Connect failed, unkown database at line 20.

Je pense que mon script ne reconnais pas la base de données.
Je continue mes investigations

Meric

clubber43

BON !!
Les problèmes de connexions et d'erreurs sont OK, je compile le code et là, j'ai un message :

DBD::mysql::db do failed you have an error in your SQL synthax à line 37, check the manual . . .
DBD::mysql::db do failed you have an error in your SQL synthax à line 37, check the manual . . .

pourtant, le script parait juste :

Code :

#!/usr/bin/perl 
use warnings; 
use strict; 
use Encode; 
use utf8; 
use DBI;            # Charger le module DBI 
 
 
ActiverAccents(); 
 
# Paramètres de connection à la base de données 
my $bd        = 'Energie'; 
my $serveur    = '127.0.0.1'; # @ IP IP 
my $identifiant = 'root';      # identifiant  
my $motdepasse    = 'admin'; 
my $port    = '3306';        #Si vous ne savez pas, ne rien mettre 
 
# Connection à la base de données mysql 
print "Connexion a la base de donnees $bd\n"; 
my $dbh = DBI->connect( "DBI:mysql:database=$bd;host=$serveur;port=$port",  
    $identifiant, $motdepasse, {  
    RaiseError => 1, 
    }   
) or die "Connection impossible a la base de donnees $bd !\n $! \n $@\n$DBI::errstr"; 
 
# Création des tables 
print "Creation de la table COMPTEUR\n"; 
my $sql_creation_table_compteur = <<"SQL"; 
  id_compteur    INT             NOT NULL PRIMARY KEY , 
  emplacement      VARCHAR( 10 )   NOT NULL , 
  batiment    VARCHAR( 10 )   NOT NULL , 
  niveau     VARCHAR( 10 )   NOT NULL )
COMMENT = 'COMPTEUR'; 
SQL
 
$dbh->do('DROP TABLE IF EXISTS compteur;') or die "Impossible de supprimer la table compteur\n\n"; 
$dbh->do($sql_creation_table_compteur) or die "Impossible de creer la table compteur\n\n"; 
 
print "Creation de la table Releves\n"; 
my $sql_creation_table_releves = <<"SQL"; 
CREATE TABLE releves ( 
  id_compteur      INT               NOT NULL  AUTO_INCREMENT PRIMARY KEY COMMENT #Elle sera generee automatiquement, 
  puissance_p      INT          NOT NULL , 
  puissance_q      INT          NOT NULL ,
  courant_I      INT          NOT NULL )
COMMENT = 'COMPTEUR'; 
SQL
 
$dbh->do('DROP TABLE IF EXISTS releves;') or die "Impossible de supprimer la table releves\n\n"; 
$dbh->do($sql_creation_table_releves) or die "Impossible de creer la table releves\n\n"; 
 
 
# Insertion des données 
my $requete_sql_compteur = <<"SQL"; 
  INSERT INTO rcompteur ( id_compteur, emplacement, batiment, niveau) 
  VALUES ( 1, TDD1, D, 1); 
SQL
 
# Deconnection de la base de donnees 
$dbh->disconnect(); 
 
 
sub ActiverAccents { 
    my $encodage; 
    # Windows 
      if ( lc($^O ) eq 'mswin32') { 
    eval { 
        my ($codepage) = ( `chcp` =~ m/:\s+(\d+)/ ); 
        $encodage = "cp$codepage"; 
        foreach my $h ( \*STDOUT, \*STDERR, \*STDIN, ) { 
        binmode $h, ":encoding($encodage)"; 
        } 
    }; 
    } 
    else { 
    $encodage = `locale charmap`; 
    eval { 
        foreach my $h ( \*STDOUT, \*STDERR, \*STDIN, ) { 
        binmode $h, ":encoding($encodage)"; 
        } 
    }; 
    } 
  return $encodage; 
}

Message édité par gilou le 12-03-2014 à 12:08:28

Publicité

Page : 1 2 3 4 5 6 7

Page Suivante

Page Précédente

Haut de page

FORUM HardWare.fr

Programmation

Perl

[Résolu] Export données en perl

Sujets relatifs
Copier données en ligne par colonne	Comment 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 PHP	Récupérer des données d'un fichier xml
Plus de sujets relatifs à : [Résolu] Export données en perl

Page générée en 0.365 secondes