1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
| #!/usr/bin/perl
use strict;
use warnings;
use feature qw(:5.14);
use File::Copy;
# Le fichier résultat sera la sortie standard : utiliser > un_fichier.txt pour le stocker
# sauf si l'option -e=<extension> est utilisée. Dans ce cas, un fichier avec l'extension
# est créé, et une commande matlab est exécutée
# Récupération des paramètres d'appel du script (on affecte au tableau @in, le tableau @ARGV)
my @in = @ARGV;
@in = map /[\*\?]/ ? glob($_) : $_, @in;
my ($file_ext) = map /^-e=(.*)$/, @in;
@in = grep !/^-[e]/, @in;
if (my @unknown_options = grep /^-/, @in) {
die "Unknown option(s): @unknown_options";
}
warn "Files will be treated one by one, each output file will be of the form <input_file>.$file_ext"
if $file_ext;
# Pour tous les fichier en entrée
sub decode81($$);
sub decode88($;$);
foreach my $in (@in) {
warn "Treating $in...\n";
# Ouvrir le fichier d'entrée en lecture
open my $IN, "<", $in or die "Can't open file $in for reading: $!";
# Ouvrir un fichier de sortie en écriture (si option -ext=<extension>)
my $out = "$in.$file_ext" if $file_ext;
open my $OUT, ">", $out or die "Can't open file $out for writing: $!"
if $out;
# Déclarer un tableau pour les lignes 88 lues avant la ligne 81
# et un scalaire pour le code décimal
my (@kept_lines, $decoded);
# Boucler sur toutes les lignes du fichier ouvert en entrée
while (my $line = <$IN>) {
# Supprimer les caractères de fin de ligne (mettre à jour la variable
# $/ s'il ne s'agit pas de \n)
chomp($line);
# Récupération du timestamp et du code hexa de la ligne
my ($timestamp, $code) = $line =~ /(.*?),.*,([\da-f]+)$/i;
# Passer à la ligne suivante si le code n'est ni 81 ni 88
next if !$code || $code !~ /^8[18]/;
if ($code =~ /^81/) {
# Si l'on a déjà décodé un code, le signaler, sinon simplement
# indiquer que l'on décode
warn "Line to decode found at $. in $in\n" if !$decoded;
warn "New line to decode at $. in $in\n" if $decoded;
# Sauvegarde de l'éventuel code décimal actuellement déjà décodé
my $old_decoded = $decoded if $decoded;
$decoded = decode81($code, $old_decoded);
# Si l'on a stocké des lignes 88 précédent cette ligne 81, les traiter en ajoutant le code décimal
if (@kept_lines) {
map { say { $OUT // *STDOUT } sprintf $_, $decoded } splice @kept_lines;
}
}
# Si la ligne n'est pas une 81 (c'est donc forcément une 88)
else {
# Décoder la ligne 88
if ($code = decode88($code, $decoded)) {
# Si le code décimal a été décodé
# traiter la ligne en ajoutant le code décimal au timestamp et au code hexa
if ($decoded) {
say { $OUT // *STDOUT } "$timestamp;$code";
}
# Si la ligne n'est pas une 81 et que le code n'est pas décodé, enregistrer la ligne (timestamp et code hexa) pour un traitement
# ultérieur (lors du traitement de la ligne 81 ; le code de la ligne n'étant pas encore connu, il est remplacé par %s qui servira de template pour sprintf)
else {
push @kept_lines, "$timestamp;$code";
}
}
}
}
undef $OUT;
if ($out) {
# Si l'option -e a été fournie, il faut appeler matlab avec le fichier $out renommé en "fichier.csv"
# Ici, on fait une copie pour garder le fichier $out intermédiaire (on peut utiliser rename à la place)
rename $out, "fichier.csv" or die "Can't create fichier.csv";
# On appelle Matlab
system("matlab -wait -r programme");
# On renomme le résultat "fichier.xls" produit par Matlab en "$in.xls".
# On ajoute simplement l'extension .xls au fichier d'entrée, c'est une mesure simplificatrice.
# On aurait aussi pu modifier l'extension du fichier d'entrée (rename "fichier.xls", $in =~ s/\.([^\.]+)$/.xls/r)
my $out = $in;
$out =~ s/.eur/.xls/;
rename "fichier.xls", "$out";
}
}
sub bin2hex($;$$) {
my ($bitcode, $group, $msb_first) = @_;
# Si $group est défini, on regroupe les bits par paquets de $group et on traite les groupes comme des digits décimaux limités à 9
# Si $group non défini, pas de regroupement, on traite la chaine de bit en un morceau)
# Par défaut, MSB first
$msb_first //= 1;
# La construction suit plusieurs étapes (pipeline de fonction à lire de droite à gauche) :
# 1- substr($bitcode, $bitpos, 32) =~ /(.{$group})/g : récupère le code binaire ASCII de 32 à la position $bitpos
# et en extrait un tableau de chaines de $group digit binaires
# grâce à une recherche d'expression régulière globale
# 2- map oct("0b$_") : pour chaque chaine binaire de 4 digits, convertir le code binaire ASCII en valeur numérique
# 3- grep $_ < 10 : pour chaque valeur numérique, ne conserver que les valeurs inférieures à 10
# 4- dans le cas LSB first, inverser les bits
# 5- join "" : concaténer sous forme "chaine" les digits décimaux ($decoded est alors une chaine
# mais qui peut être utilisée dans un contexte numérique comme une valeur numérique)
my @bits = $group ? grep $_ < 10, map oct("0b$_"), $bitcode =~ /(.{$group})/g : oct("0b$bitcode");
map reverse, @bits if !$msb_first;
return join "", @bits;
}
sub decode81($$) {
my ($code, $old_decoded) = @_;
# Convertir le code hexa en binaire
# La transformation s'opère en deux temps :
# pack("H*", $code) code en "binaire" le code hexa récupéré sous forme ASCII
# puis unpack("B*", ...) décode le "binaire" en code binaire sous forme ASCII
# "binaire" signifiant ici de vrai binaire numérique (comme il est stocké dans un entier numérique).
# Les formats majuscules imposent un sens de code hexa et binaire "MSB" first (bit de poids fort en premier)
my $bitcode = unpack("B*", pack("H*", $code));
my $bit75 = substr($bitcode, 74, 8);
# Déclaration d'une variable qui contiendra la position des 32bits à décoder
my $bitpos;
#si paquet 0
if ($bit75 eq "00000000") {
my $bit171 = substr($bitcode, 170, 2);
#Si Q_LENGTH égal 0 ou 3
if ($bit171 eq "00" || $bit171 eq "11") {
#NID_OPERATIONAL
$bitpos = substr($bitcode, 185, 3) eq "001" ? 217 : 209;
}
else {
#NID_OPERATIONAL
$bitpos = substr($bitcode, 200, 3) eq "001" ? 232 : 224;
}
}
#Si paquet 1
elsif ($bit75 eq "00000001") {
my $bit195 = substr($bitcode, 194, 2);
#Si Q_LENGTH égal 0 ou 3
if ($bit195 eq "00" || $bit195 eq "11") {
#NID_OPERATIONAL
$bitpos = substr($bitcode, 209, 3) eq "001" ? 241 : 232;
}
else {
#NID_OPERATIONAL
$bitpos = substr($bitcode, 222, 3) eq "001" ? 254 : 246;
}
}
# Construction du code décimal
my $decoded = bin2hex(substr($bitcode, $bitpos, 32), 4) if $bitpos;
# Trivial
if ($old_decoded) {
if ($decoded != $old_decoded) {
warn "-> new decoded value is different from first occurence: old = $old_decoded, new = $decoded\n";
}
else {
warn "-> same value ($decoded == $old_decoded)\n";
}
}
return $decoded;
}
sub decode88($;$) {
my ($code, $code81) = @_;
my $decoded = $code;
# Si le code de la ligne 81 n'est pas encore connu, il est remplacé par %s qui servira de template pour sprintf
$code81 //= "%s";
my @decoded = ($code81);
# Convertir le code hexa en binaire
my $bitcode = unpack("B*", pack("H*", $code));
my $bit75 = substr($bitcode, 74, 8);
# Déclaration d'une variable qui contiendra la position des 32bits à décoder
my $bitpos;
if ($bit75 eq "00000000") {
my $bit171 = substr($bitcode, 170, 2);
if ($bit171 eq "00" || $bit171 eq "11") {
# Test du bit 186, M_LEVEL, si M_LEVEL différent de 3 (011) ce n'est pas un ERTMS niveau 2, donc on peut supprimer la ligne
if (substr($bitcode, 185, 3) ne "011") {
$decoded = undef;
}
}
else {
# test du bit 201, M_LEVEL, si M_LEVEL différent de 3 (011) ce n'est pas un ERTMS niveau 2, donc on peut supprimer la ligne
if (substr($bitcode, 200, 3) ne "011") {
$decoded = undef;
}
}
}
elsif ($bit75 eq "00000001") {
my $bit195 = substr($bitcode, 194, 2);
if ($bit195 eq "00" || $bit195 eq "11") {
# Test du bit 210, M_LEVEL, si M_LEVEL différent de 3 (011) ce n'est pas un ERTMS niveau 2, donc on peut supprimer la ligne
if (substr($bitcode, 209, 3) ne "011") {
$decoded = undef;
}
}
else {
# test du bit 225, M_LEVEL, si M_LEVEL différent de 3 (011) ce n'est pas un ERTMS niveau 2, donc on peut supprimer la ligne
if (substr($bitcode, 224, 3) ne "011") {
$decoded = undef;
}
}
}
if ($decoded) {
if ($bit75 eq "00000000") {
my $bit171 = substr($bitcode, 170, 2);
if ($bit171 eq "00" || $bit171 eq "11") {
$bitpos = substr($bitcode, 172, 1) eq "1" ? 179 : 173;
#décodage de la vitesse, multiplié par 5
push @decoded, 5*bin2hex(substr($bitcode, 172, 7), undef, 0);
}
else {
$bitpos = substr($bitcode, 188, 1) eq "1" ? 194 : 188;
#décodage de la vitesse, multiplié par 5
push @decoded, 5*bin2hex(substr($bitcode, 187, 7), undef, 0);
}
}
elsif ($bit75 eq "00000001") {
my $bit194 = substr($bitcode, 193, 2);
if ($bit194 eq "00" || $bit194 eq "11") {
$bitpos = substr($bitcode, 197, 1) eq "1" ? 203 : 197;
#décodage de la vitesse, multiplié par 5
push @decoded, 5*bin2hex(substr($bitcode, 196, 7), undef, 0);
}
else {
$bitpos = substr($bitcode, 211, 1) eq "1" ? 218 : 212;
#décodage de la vitesse, multiplié par 5
push @decoded, 5*bin2hex(substr($bitcode, 211, 7), undef, 0);
}
}
# Decoder les bit 51 à 74, NID_ENGINE
push @decoded, bin2hex(substr($bitcode, 50, 74-50), undef, 0);
# Decoder les bits 108 à 122, LRBG
push @decoded, bin2hex(substr($bitcode, 107, 122-108), undef, 0);
# Test du bit 82 pour décodage dernière colonne
my $bit82 = substr($bitcode, 81, 1);
#D_LRBG
my $last_col = bin2hex(substr($bitcode, $bit82 eq "0" ? 121 : 145, $bit82 eq "0" ? 137-122 : 161-146), undef, 0);
# Decodage du multiplicateur, pour le D_LRBG analyse du Q_LENGTH pour savoir si c'est en cm ou en m.
my $bit96 = substr($bitcode, 95, 2);
my $multi = $bit96 eq "00" || $bit96 eq "10" ? 10 : $bit96 eq "01" ? 1 : undef;
my $last_col_unit = $bit96 eq "00" ? "cm" : $bit96 eq "01" || $bit96 eq "10" ? "m" : "";
push @decoded, ($last_col * $multi).$last_col_unit if $multi;
#$decoded = join ";", $code, @decoded;
#permet de supprimer le message 88, et de garder le reste, les colonnes sont donc respectivement:
# date-heure, NID_OPERATIONAL, vitesse, NID_ENGINE,LRBG,D_LRBG.
$decoded = join ";", @decoded;
}
return $decoded;
} |
Répondre avec citation
Envoyé par mimieloic
Partager