Compréhension d'un fragment de code inconnu

Version imprimable

Bonjour à tous, :)

Avant tout, je tiens à vous avertir que je n'utilise pas le langage Perl, mon domaine, c'est plutôt le PHP, Java, WinDev et C#.

Voici ma situation, je recherchait sur le Web un moyen d'extraire d'un fichier structuré précis les petits fichiers imbriqués qu'il contient, une sorte d'archive non compressée en quelque sorte. Je ne connais pas la position exacte de ces petits fichiers donc je n'ai pas pu les extraire moi-même. :?

En cherchant longtemps, j'ai trouvé la solution sur un site anglais sous la forme d'un script Perl, parsant un fichier texte (contenant les offsets des différents petits fichiers, le gars avait fait une autre manipulation pour les obtenir) pour envoyer ses infos à un exécutable en ligne de commande qui se charge ensuite de découper l'archive comme il faut. :D

Malheureusement, ce petit exécutable (sûrement très vieux) ne fonctionne pas sur toutes les machines que j'ai testé. Et je ne ne connais aucun autre programme en ligne de commande pour le remplaçer. :( Pour contourner le problème, j'ai entrepris de me documenter un peu sur Perl pour traduire rapidement son script en PHP, extraction compris (le plus simple à mon goût).

J'ai casiment réussi à tout comprendre de son code, cependant je bute sur une petite partie, et j'avoue que je m'arrache un peu les cheveux là (bon sang...). La voici :
Code:

1 2 $int = unpack("N", pack("H8", substr("0" x 8 . "$offset", -8))); $dec = sprintf("%d", $int);
Donc j'aimerais qu'une personne qui soit plus à l'aise que moi en Perl m'explique ce que le gars fait à ce moment là.

Le script complet est ici :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 %ext = (); open (INDEX, "CA013R.txt"); @index = <INDEX>; $size = @index; $marker = 1; while ($marker <= $size) { ($offset2, $lba2, $extension2, $description2) = split(/\t/, $index[$marker]); ($offset, $lba, $extension, $description) = split(/\t/, $index[$marker - 1]); $ext{$extension}++; $filename = "mushi" . $ext{$extension} . "." . lc($extension); $int = unpack("N", pack("H8", substr("0" x 8 . "$offset", -8))); $dec = sprintf("%d", $int); $int2 = unpack("N", pack("H8", substr("0" x 8 . "$offset2", -8))); $dec2 = sprintf("%d", $int2); if ($dec2 == 0) { $dec2 = "End of file"; } print "Extracing $extension file from $dec to $dec2 as $filename\n"; `gimme.exe CA013R.PDM $filename $dec $dec2`; $marker++; }
J'espère que quelqu'un pourra me donner une explication. ;)

Citation:
Envoyé par Cyberstein
Code:

1 2 $int = unpack("N", pack("H8", substr("0" x 8 . "$offset", -8))); $dec = sprintf("%d", $int);
C'est une façon très complexe de faire :

Code:

$dec = hex $offset;

(hex()) Ce script n'a pas été écrit par une foudre en Perl...
Citation:
Envoyé par Cyberstein
Donc j'aimerais qu'une personne qui soit plus à l'aise que moi en Perl m'explique ce que le gars fait à ce moment là.

Le script complet est ici :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 %ext = (); open (INDEX, "CA013R.txt"); @index = <INDEX>; $size = @index; $marker = 1; while ($marker <= $size) { ($offset2, $lba2, $extension2, $description2) = split(/\t/, $index[$marker]); ($offset, $lba, $extension, $description) = split(/\t/, $index[$marker - 1]); $ext{$extension}++; $filename = "mushi" . $ext{$extension} . "." . lc($extension); $int = unpack("N", pack("H8", substr("0" x 8 . "$offset", -8))); $dec = sprintf("%d", $int); $int2 = unpack("N", pack("H8", substr("0" x 8 . "$offset2", -8))); $dec2 = sprintf("%d", $int2); if ($dec2 == 0) { $dec2 = "End of file"; } print "Extracing $extension file from $dec to $dec2 as $filename\n"; `gimme.exe CA013R.PDM $filename $dec $dec2`; $marker++; }
J'espère que quelqu'un pourra me donner une explication. ;)
Le code a l'air d'être correct (même s'il est assez laid...), quel est ton problème ? Tu n'as pas "gimme.exe" ?

--
Jedaï

21/01/2008, 01h10
Schmorgluck

En effet, c'est tordu. Examinons tout pas à pas.

Code:

substr("0" x 8 . "$offset", -8)

Extrait les 8 derniers caractères d'une chaîne constituée de huit "0" suivi de la valeur de la chaîne offset. Les huit "0" doivent servir, je suppose, à éviter les problèmes si la chaîne est de taille inférieure à 8, ce qui est une précaution inutile (mais peut-être pas à l'époque du script).

Code:

unpack("N", pack("H8", substr("0" x 8 . "$offset", -8)));

Là, ça devient fun : pack interprête comme un nombre hexadécimal à 8 chiffres la chaîne renvoyée par substr, et la convertit en entier sous la forme d'octets dans une chaîne, puis unpack lit cette chaîne et la convertit en véritable entier.
Comment dire... Je ne connais pas l'histoire de Perl en détail, et j'ignore donc si la fonction hex a toujours existé ni quand elle est apparue, mais j'imagine que ça fait quand même un bail. Alors en effet, soit ce script est vraiment très vieux, soit son auteur s'est embêté pour rien.
Donc, pour résumer, cette ligne est équivalente à

Code:

$int=hex(substr($offset),-8);

Et encore, le substr n'est probablement pas nécessaire, mais je manque d'infos pour l'affirmer (peut-être arrive-t-il que $offset contienne davantage que le nombre hexa - improbable, mais on ne sait jamais).

Pour ce qui est de la ligne suivante, elle sert à convertir $int en chaîne représentant un entier, et ce avec une chaîne de format basique. Autant dire qu'elle équivaut à

Code:

$dec="$int";

Le but étant apparemment de l'utiliser dans les backquotes. Manoeuvre inutile, encore une fois, puisque l'interpolation aurait lieu de toute façon.
En tout état de cause, ces deux lignes pourraient être remplacées par celle-ci :

Code:

$dec=hex(substr($offset),-8);

J'espère que c'est plus clair pour toi.

EDIT : rhaaaah, je suis leeeeeeent !
21/01/2008, 09h20
Cyberstein

Merci à tous ! Vous êtes formidable !! :ccool:

Je ne vous le cacherez pas, la personne qui à mis en ligne ceci à avoué d'elle-même ne pas être un expert en Perl... :roll:

Mais comme je n'en suis moi-même pas un, j'ai préféré ne rien dire même si certaines parties du code me faisaient déjà tiquer.

Citation:

Envoyé par Jedai

Le code a l'air d'être correct (même s'il est assez laid...), quel est ton problème ? Tu n'as pas "gimme.exe" ?

Précisément, en fait je l'ai mais il plante (il doit être trop vieux) et je n'ai rien d'autre sous la main pour le remplacer, d'où ma volonté de faire un script PHP qui extraira lui-même les fichiers. :)

Citation:

Envoyé par Schmorgluck

Extrait les 8 derniers caractères d'une chaîne constituée de huit "0" suivi de la valeur de la chaîne offset. Les huit "0" doivent servir, je suppose, à éviter les problèmes si la chaîne est de taille inférieure à 8, ce qui est une précaution inutile (mais peut-être pas à l'époque du script).

[...]

Comment dire... Je ne connais pas l'histoire de Perl en détail, et j'ignore donc si la fonction hex a toujours existé ni quand elle est apparue, mais j'imagine que ça fait quand même un bail. Alors en effet, soit ce script est vraiment très vieux, soit son auteur s'est embêté pour rien.
Donc, pour résumer, cette ligne est équivalente à

Code:

$int=hex(substr($offset),-8);

Et encore, le substr n'est probablement pas nécessaire, mais je manque d'infos pour l'affirmer (peut-être arrive-t-il que $offset contienne davantage que le nombre hexa - improbable, mais on ne sait jamais).

Si tu veut savoir toute l'histoire, ce script à été réalisé en Juillet 2005. Et toutes les chaînes de caractères qu'offset reçoit font rigoureusement 8 caractères (le fichier texte est formaté proprement)...

Bref, encore merci ! :king:

Citation:

Envoyé par Cyberstein

Précisément, en fait je l'ai mais il plante (il doit être trop vieux) et je n'ai rien d'autre sous la main pour le remplacer, d'où ma volonté de faire un script PHP qui extraira lui-même les fichiers. :)

Remplace juste l'appel à gimme.exe par une petite fonction Perl :

Code:

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
#!/usr/bin/perl
use strict; use warnings;
 
my %ext;
 
my @index = do { 
    open my($index), '<', 'CA013R.txt'
	or die "$!\n";
    <$index>;
};
 
for my $marker (1 .. @index) {
    my ($offset2, $lba2, $extension2, $description2) =
	split(/\t/, $index[$marker]);
    my ($offset, $lba, $extension, $description) =
	split(/\t/, $index[$marker - 1]);
    $ext{$extension}++;
    my $filename = "mushi" . $ext{$extension} . "." . lc($extension);
    my $dec = hex $offset;
    my $dec2 = hex $offset2;
    if ($dec2 == 0) {
	$dec2 =	-s "CA013R.PDM";
    }
    print "Extracting $extension file from $dec to $dec2 as $filename\n";
    extract('CA013R.PDM', $filename, $dec, $dec2);
}
 
 
sub extract {
    my($name_in, $name_out, $from, $to) = @_;
    open my($file_in), '<:raw', $name_in
	or die "Can't read $name_in : $!\n";
    open my($file_out), '>:raw', $name_out
	or die "Can't write $name_out : $!\n";
 
    seek $file_in, $from, 0;
    read $file_in, my($content), $to - $from;
    print {$file_out} $content;
}
 
__END__

Un truc comme ça.

--
Jedaï

22/01/2008, 18h43
Cyberstein

Et ben, j'espère que ça marchera. Ca m'évitera d'avoir à refaire le script. :mrgreen:

(ça tombe bien avec mon projet j'ai peu de temps libre)

Merci à toi Jedai ! :ave:

EDIT: LE SCRIPT FONCTIONNE !