Bonsoir,
 
Je n'arrive pas à réaliser la même chose sous Perl que mon résultat en Awk.
J'ai essayé le awk2perl mais sans succès.
 
Mon souhait est assez simple, j'ai un fichier de sortie que je split, puis sur 2 colonnes je veux savoir le nombre d’occurrence totale et les trier.
Avec un exemple cela sera plus parlant.
 
Mon fichier de donnée:

 
Ma commande en awk:

cat test | awk -v FS=";" '{print substr($4,1,3)";"$5}' | sort -f | uniq -ic | sort -f -n -k1,1 -r | awk 'NR == 1 , NR == 5' | awk '{if (NR<10) {print 0NR":"$0} else {print NR":"$0}}'

 
Mon résultat:

 
C'est exactement ce que je souhaite,
J'ai ici un genre de TOP5.
Avec le Awk j'affiche même les n° de ligne.
 
Mon script Perl ci-dessous n'apporte évidement pas la solution,
J'ai beau essayé avec des sorts array, des map, je n'arrive pas au même résultat.
C'est un aspect que je ne maîtrise pas encore et les recherches sur le net restent pour le moment infructueux.
Là où je pèche vraiment c'est sur l'équivalent du "uniq -c"
 

#!/usr/bin/perl -w
use warnings;
use strict;
 
use MIME::Lite;
use Net::Ping;
use File::Copy;
use File::Find;
use Encode;
my ($i, $y) = (0, 0);
opendir(DIR, $DIR) or die "Can't open $DIR: $!";
    my $SEARCH_FILE = "billing_$mday-$mon-$year";
    my @bil = grep(/$SEARCH_FILE/,readdir(DIR));
    closedir(DIR) or warn "Can't close $DIR: $!";
    if (@bil > 0)    {
        foreach my $file (@bil)    {
            open (FILE, "<", $DIR . $file);
            while (<FILE> )    {
                chomp $_;
                my @tab=split(/;/,$_);
                if ($tab[11] == 490)    {
                    next;
                }
                if (! $hash{$tab[0]."|".$tab[2]."|".$tab[3]."|".$tab[6]})    {
                    $hash{$tab[0]."|".$tab[2]."|".$tab[3]."|".$tab[6]}=1;
                    $nbligne=keys(%hash);
                    if ($tab[5] == 0)    {
                        ++$i;
                        print $tab[3]."|".$tab[4]. "\n";
                    }
                    else {
                        ++$y;
                    }
                }
            }
            close (FILE) or warn "Message : $!\n";
        }
        foreach my $del (@bil)    {
            unlink $DIR.$del;
        }
    }
}

 
 
Merci pour votre aide.
Cordialement.

Bon j'ai codé ça vite fait, ça pourrait peut être être avec des noms de variable mieux choisis

#!/usr/bin/perl
 
# error-check flags
use strict;
use warnings;
# Use readable built-in names
use English qw( -no_match_vars );
 
my $filename = 'data.txt'; # fichier des données
open(my $fh, '<', $filename) or die "$filename: fichier pas trouve!"; # ouverture en lecture
my %stuff;  # nom a remplacer par un plus adapte
while (<$fh> ) {
 next if (/^\s*$/); # on saute les lignes vide a tout hasard
 my @fields = split /;/, $_;
 $stuff{substr($fields[3], 0, 3).';'.$fields[4]}++;
}
close $fh;
 
my $cnt = 0;
foreach my $key (sort {$stuff{$b} <=> $stuff{$a}} (keys(%stuff))) {
  ++$cnt;
   print "$cnt:\t$stuff{$key} $key\n";
}

C'est pourtant simple:
On splitte une ligne en champs sur les ;
my @fields = split /;/, $_;
On ne garde que ce qu'on veux dans les champs.
Manifestement, c'est les 3 premiers caractères du 4e champ, et le 5e champ, avec un ; entre les deux
substr($fields[3], 0, 3).';'.$fields[4]
Je m'en sert comme clé d'un hash, dont la valeur est incrémenté chaque fois que la clé est trouvée
$stuff{substr($fields[3], 0, 3).';'.$fields[4]}++;
Après, c'est juste le fait d'imprimer le hash trié par valeur décroissante (ça c'est un truc que que retiens jamais, mais qu'un coup de google permet de retrouver).
 
Sur vos données:

A+,

Il est fort ce Gilou !    
Nickel, heureusement que tu es là !
C'est toujours quand c'est simple que j'ai besoin d'un p'tit coup de pouce pour débloquer tout ça.
 
 
Pour la variable $cnt, il me reste juste à afficher un 0 quand c'est inférieur à 10.
Ex: 01, 02, 03
Au lieu de: 1, 2, 3
 
Le code ci-dessous fonctionne comme il faut.
Avez-vous un remarque dessus? Est-ce que la démarche est bonne?
 

my $cnt = 0;
foreach my $key (sort {$top20{$b} <=> $top20{$a}} (keys(%top20))) {
  if ($cnt < 10) {
      $cnt = sprintf '%.2d', $cnt;
  }
  ++$cnt;
  print "$cnt:\t$top20{$key} $key\n";
  if ($cnt == 20) {
      last;
  }
}

 
Encore merci Gilou.
Cdt.

Oui, pourquoi faire simple quand on peut faire compliqué?
Vous avez besoin de formatage précis, alors il suffit d'utiliser printf au lieu de print.
Remplacez le
print "$cnt:\t$stuff{$key} $key\n";
par
printf "%.2d:\t%s %s\n", $cnt, $stuff{$key}, $key;
ou bien par  
printf("%.2d:\t%s %s\n", $cnt, $stuff{$key}, $key);  
si vous préférez, avec les parenthèses, que ça soit comme en C.
et c'est réglé.
 
Et sinon, je vois que vous voulez afficher au plus 20 lignes.
Alors ceci convient:

my $cnt = 0;
foreach my $key ((sort {$stuff{$b} <=> $stuff{$a}} (keys(%stuff)))[0..maxlines(\%stuff, 20)]) {
  printf "%.2d:\t%s %s\n", ++$cnt, $stuff{$key}, $key;
}
 
sub maxlines {
  my ($h, $i, $j);
  ($h, $i) = @_;
  $j = 0+(keys(%$h));
  return (--$i>--$j?$j:$i);
}

Plutot que tester ou on en est dans le corps de boucle, autant ne faire la boucle que sur les 20 premières valeurs triées (si @a est un tableau, @a[0..19] est le tableau des 20 premières valeurs de @a).
Comme on ne sait pas s'il y a 20 valeurs dans le tableau, maxlines vérifie cela, et si le nb de lignes qu'on veut afficher est trop grand, il renvoie le nombre de lignes max du tableau (décrémenté de 1, pour coller avec le fait qu'on commence a compter à partir de 0).
 
A+,

Bonjour,
 
Excellent !
Merci Gilou, tu m'apprends encore de nouvelles choses.
 
J'ai une dernière question sur le sujet,
Imaginons que pour filtrer encore plus mon top5, je décide de rajouter un champ dans mon hash

$stuff{substr($fields[3], 0, 3).';'.$fields[4].';'.$fields[3]}++;

 
A ce moment là en faisant un nouveau :

foreach my $key ((sort {$stuff{$b} <=> $stuff{$a}} (keys(%stuff)))[0..maxlines(\%stuff, 20)]) {
  printf "%.2d:\t%s %s\n", ++$cnt, $stuff{$key}, $key;
}

 
Il va m'afficher toutes les clés de mon hash, dont ce nouveau champ.
Or, je ne veux pas afficher ce nouveau $fields[3] dans mon print.
 
Comment faire?

Le plus simple, c'est de copier $key de que tu veux de $key dans une variable, et utiliser cette variable pour le printf.
Ici, on peut faire plus simple: on peut récupérer directement ce que l'on veut afficher avec une expression régulière sur key:

my $cnt = 0;
foreach my $key ((sort {$stuff{$b} <=> $stuff{$a}} (keys(%stuff)))[0..maxlines(\%stuff, 20)]) {
  $key =~ m/^(.*);/o;
  printf("%.2d:\t%s %s\n", ++$cnt, $stuff{$key}, $1);
}

 
Bon ensuite, si on veut vraiment un truc compact (donc dans l'esprit perl, mais moins lisible), on peut condenser ça en:

my $cnt = 0;
foreach ((sort {$stuff{$b} <=> $stuff{$a}} (keys(%stuff)))[0..maxlines(\%stuff, 20)]) {
  printf("%.2d:\t%s %s\n", ++$cnt, $stuff{$_}, (m/^(.*);/o and $1));
}

 
A+,

Bonjour Gilou,
 
Merci cela fonctionne comme toujours !  
 
Peux-tu me décrypter ton expression régulière?
$key =~ m/^(.*);/o;
De ce que je comprends tu récupères avec le (.*) toutes les clés.
A quoi correspond le "o" et le $1 ?
 
Pour une meilleur lisibilité,
Si je veux changer le séparateur ";" par un "\t"
Je n'arrive pas le changer dans ta regex avec le "\\t"
 
Merci.

$key =~ m/^(.*);/o;  
C'est un truc paumant à première vue, car la syntaxe est inattendue.
ça matche l'expression régulière sur $key ( le =~ ne met rien dans $key ). Le premier et unique groupe matché est mis dans $1, comme d'hab.
Ce groupe est (.*) donc tous les caractères, /^ depuis le début, ;/ et avant un ;
Comme en perl par défaut, le match est maximal, ce sera donc tous les caractères depuis le début et avant le dernier ; de la ligne, donc avant le champ ajouté a la fin et séparé par le ;
le o signifie qu'on ne calcule l'expression régulière qu'une fois, car elle ne change pas entre deux tests (clair, car elle ne contient rien de variable).
 

 
Changer ça ou donc? et pourquoi?
 
A+,

Même dans les explications, ce gilou il est fort.
Merci c'est nettement plus clair !
 
Pour ma dernière demande, je me suis trompé
C'était tout bête
Je faisais:

$key =~ m/^(.*)\\t/o;

 
Au lieu de:

$key =~ m/^(.*)\t/o;

 
 
C'était dans le cas ou mon hash aurait eu cette forme:

$stuff{substr($fields[3], 0, 3)."\t".$fields[4]."\t".$fields[3]}++;

Ah OK!
Comme il y avait déjà des ; dans les lignes, je craignais que ce ne fusse de ceux la qu'il s'agisse.
 
Le truc à savoir en perl, mais qui est très mal documenté, c'est qu'on peut assigner la capture d'un groupe matché à une variable (si on veut ses variables a soi, car les $1, $2... sont réassignées au prochain matching), mais qu'il faut être en contexte de liste, car en contexte scalaire, on a pour valeur 1 s'il y a match de l'expression régulière, et 0 sinon.
 

my $text = "aa;bb;cc";
# en scalar context
my $foo = $text =~ m/^([^;]+);([^;]+)/;
print $foo, "\n";
# le même, mais en list context
($foo) = $text =~ m/^([^;]+);([^;]+)/;
print $foo, "\n";
# list context avec deux elements dans la liste
my $bar;
($foo, $bar) = $text =~ m/^([^;]+);([^;]+)/;
print $foo, " ", $bar, "\n";

 
A+,

Top !  
Merci Gilou, j'ajoute cela dans mes notes sur Perl.
 
Ultime question,
Grâce à toi mon top 10 est en place,
Cependant, j'aimerai pouvoir gérer la "casse"
 
Je peux avoir des titres avec:
- Chaise
- chaise
 
Du coup, dans le hash il compte cela pour 2.
 
Est-ce possible de dire au hash de ne pas faire attention à la casse?
Tel un "uniq -i" ou un "sort -f" en bash?
 
Ou bien ce n'est pas possible et par conséquent il faut passer par une regex de folie pour gérer la casse sur le champ titre?
 
Sachant que mon champ titre peut comporter des espaces, tirets
Ex: Grey's Anatomy - S8 Ep 01

Ben pour gérer la casse, tu peux faire ça au niveau de la clé: tu met les champs en homogénéité de casse avec lc et uc, et éventuellement, tu rajoutes un coup de ucfirst, si tu veux une première lettre en majuscule.
Par exemple, tu met dans ta cle le premier champ tout en majuscule et le second en minuscule, avec le première lettre en majuscule:  
uc(substr($fields[3], 0, 3)).';'.lc($fields[4])  
pour la clé au lieu de  
substr($fields[3], 0, 3).';'.$fields[4]
Tu peux utiliser uc (tout en majuscules), lc (tout en minuscules) et ucfirst (première lettre en majuscule, on touche pas aux autres), selon tes besoins.
A+,

Top !  
 
Bien vu.
 
J'imagine que si on veut la première lettre de chaque mot en majuscule,
Il faut combiner le ucfirst avec une regex qui manipule cela dès qu'elle détecte un espace, non?
 
Merci encore Gilou,
Ô Capitaine, mon capitaine  

C'est mieux de faire cela lorsque la regexp détecte un mot, non? donc matcher sur \w+
 

my $text = "toto tata tutu";
print "$text \n";
$text =~ s/\w+/ucfirst($& )/ge;
print "$text \n";

$& représente ce qui est matché en tout entre les // (on pourrait faire aussi: s/(\w+)/ucfirst($1)/ge; )
le /e c'est pour que le ucfirst soit exécuté dans l'expression de remplacement et non considéré comme du texte.
le /g, c'est pour que ce soit appliqué répétitivement et pas limité au premier mot trouvé
 
A+,

Merci Gilou !
 
Encore une explication royale
Merci.

Avec le \w il me détecte les accents (é, ê, è ...) comme un mot
 

 
J'essaye d'avoir:

 
Sachant qu'avant traitement de ce champ titre, j'utilise le "use Encode" pour réencoder la ligne sur du ISO-8859-1
 

$tab[4]=encode("iso-8859-1", decode("utf8", $tab[4]));

Si ton fichier est en utf8, il faut l'ouvrir en utf8, et tout collera dans les regexp:
 
open(my $fh, '<:utf8', $filename) or die "$filename: fichier pas trouve!"; # ouverture en lecture
 
Et si je remplace les lignes avec THD 4;Numero en entrées par des lignes avec THD 4;éNuméro
ça me donne en sortie pour ces lignes la
02: 3 THD;Énuméro 1
avec un bon passage a la minuscule accentuée en majuscule accentuée
Bon pour le voir, il faut rediriger la sortie dans un fichier, vu que la fenêtre DOS ne sait pas afficher de l'UTF-8
 
Et sinon (pas en unicode au départ), il vaut mieux tout transcoder en unicode avant traitement, si il y a des caractères spéciaux (accents, etc) qui sont à prendre en compte, vu que les propriétés sur les caractères sont bien gérées au niveau unicode.
 
A+,

Excellent, avec la simple ouverture en utf8 je n'ai même plus besoin de faire le encode,decode.
 
Merci !