[Perl] Besoin d'aide

print scalar @trie,"\n";
print scalar @$_ for @trie;print for sort @reste;

#!/usr/bin/perl
use strict;use warnings;

open F,"access.log"  or die "E/S: $!\n";
open FF,"vhost.conf" or die "E/S: $!\n";
open FFF,">vhostjjmmaaaa.log" or die "E/S: $!\n";

# 1ère partie : obtenir les tableaux
my (@f1,@f2,@reste,%h);
push @f1,(split ":",$_)[0] and push @f2,(split ":",$_)[1] while(<FF>);
chomp@f2;

# 2ème partie : faire le tri par rapport au tableau @f1
while (<F>){
          /^(.*?)\s/;push @{$h{$1}},$_ if grep{/$1/} @f1;
            push @reste,$_ unless grep{/$1/}@f1;
}

my @trie = map  { $_->[1] }
           sort { $b->[0] <=> $a->[0] }
           map  { [ @$_+0, $_ ] } values %h;

print sort @$_ for @trie;print for sort @reste;

for my $e(@trie){
  for (@{$e}){
    /^(.*?)\s.*/ and print FFF grep { /^$1/ } qx/cat vhost.conf/;
  }
}
__END__

#!/usr/bin/perl
use strict;use warnings;

open F,"access.log"  or die "E/S: $!\n";
open FF,"vhost.conf" or die "E/S: $!\n";

# 1ère partie : obtenir les tableaux
my (@f1,@f2,@reste,%h);
push @f1,(split ":",$_)[0] and push @f2,(split ":",$_)[1] while(<FF>);
chomp@f2;

# 2ème partie : faire le tri par rapport au tableau @f1
while (<F>){
          /^(.*?)\s/;push @{$h{$1}},$_ if grep{/$1/} @f1;
            push @reste,$_ unless grep{/$1/}@f1;
}

my @trie = map  { $_->[1] }
           sort { $b->[0] <=> $a->[0] }
           map  { [ @$_+0, $_ ] } values %h;

#print sort @$_ for @trie;print for sort @reste;

for my $e(@trie){
  for (@{$e}){
    /^((.*?\.).*?)\s.*/;
    my $fic = "$2" . qx/date '+%d%m%Y'/;
    open FFF,">>$fic" or die "E/S : $!\n";
    print FFF grep { /^$1/ } qx/cat vhost.conf/;
    close $fic;

  }
}
__END__

#!/usr/bin/perl
use strict;use warnings;
open F,"access.log"  or die "E/S: $!\n";
my %h;

while(<F>){
  next unless /^(.*?)\s.*/;
  $h{$1}++;
}
for (keys %h){
  my $z=$_;
  /^(.*?\.).*/;
  chomp(my $fic="$1" . qx/date '+%d%m%Y'/);
  my $c = grep { /^$z/ } qx/cat vhost.conf/;
  if($c>0){
    open FFF,">>$fic" or die "E/S : $!\n";
    print FFF grep { /^$z/ } qx/cat access.log/;
    close $fic;
  }
}
__END__

lami20j@debian:/mnt/hda5/accesslog$ wc -l access.log; du -h access.log
20054931 access.log
3,4G    access.log

lami20j@debian:/mnt/hda5/accesslog$ time perl stock_accesslog_v4.pl
Complété

real    116m2.399s
user    2m49.391s
sys     0m42.367s

lami20j@debian:/mnt/hda5/accesslog$ time perl stock_accesslog_v5.pl

real    8m39.852s
user    2m51.499s
sys     0m31.422s

#!/usr/bin/perl
open F,"access.log" or die "E/S: $!\n";
open FF,"vhost.conf" or die "E/S: $!\n";
my (%h,%vhost);
chomp(my $date=qx/date '+%d%m%Y'/);

while(<FF>){
  /^(.*):.*/;
  $vhost{$1}++;
}

for(keys %vhost){
  /^(.*?)\..*/;
  my $vhostjjmmaa = "$1.$date";
  open $vhostjjmmaa,">>${vhostjjmmaa}.log" or die "E/S: $!\n";
}

while(<F>){
  next unless /^((.*?)\..*?)\s.*/;
  my $FH = "$2." . $date;
  print $FH $_;
}

for(keys %vhost){
  /^(.*?)\..*/;
  close "$1.$date";
}
__END__

Mais après cette histoire, je me pose une question.
Pourquoi ne pas configurer une des directives (TransferLog, CustomLog) directement dans la configuration des VirtualHost ?
Comme ça il n'y a plus besoin d'un script Perl pour avoir les logs par vhost.
Apache s'occupera lui même.

#!/usr/bin/perl
open F,"access.log" or die "E/S: $!\n";
open FF,"vhost.conf" or die "E/S: $!\n";
my (%h,%vhost);
chomp(my $date=qx/date '+%d%m%Y'/);

while(<FF>){
  s/\s*$//g;
  /^(.*):(.*)/;
  $vhost{$1}=$2;
}

for(keys %vhost){
  s/^\s*//g;
  /^(.*?)\..*/;
  my $vhostjjmmaa = "$1.$date";
  my $handle=$_;
  open $handle,">$vhost{$_}${vhostjjmmaa}.log" or die "E/S: $!\n";
}

while(<F>){
  next unless /^((.*?)\..*?)\s.*/;
  my $FH=$1;
  print $FH $_;
}

for(keys %vhost){ close $_;}

for(values %vhost){
  opendir(REP,$_);
  while(my $fic=readdir REP){
    next if $fic=~/\.\.?$/;
    chomp(my $taille = qx/du -sh "$_$fic"/);
    unlink "$_$fic" if $taille=~/^0/;
  }
  close REP;
}

__END__

#!/usr/bin/perl
open F,"access.log" or die "E/S: $!\n";
open FF,"vhost.conf" or die "E/S: $!\n";
my (%h,%vhost);
# la date du système
chomp(my $date=qx/date '+%d%m%Y'/);

# la cle du hash    = le nom de domaine
# la valeur du hash = le répertoire /mnt/....
while(<FF>){
  s/\s*$//g;
  /^(.*):(.*)/;
  $vhost{$1}=$2;
}

# ouverture d'un handle de fichier en écriture
# pour chaque fichier (dans /mnt/...)
for(keys %vhost){
  s/^\s*//g;
  /^(.*?)\..*/;
  my $vhostjjmmaa = "$1.$date";
  my $handle=$_;
  open $handle,">$vhost{$_}${vhostjjmmaa}.log" or die "E/S: $!\n";
}

# access.log est parcouru une seule fois
while(<F>){
# saute les lignes qui ne correspondent aux nom domaines
  next unless /^((.*?)\..*?)\s.*/;
  my $FH=$1; # je stocke la chaîne de caractères
             # qui corresponde aux handle ouvert
  print $FH $_; # j'écris dans le handle (le fichier /mnt/../vhostjjmmaa.log
}

# fermeture des handles ouverts
for(keys %vhost){ close $_;}

# suppression des fichiers vides dans /mnt/..
for(values %vhost){ # pour chaque vhost
  opendir(REP,$_);  # handle vers /mnt/..
  while(my $fic=readdir REP){ # chaque fichier
    next if $fic=~/\.\.?$/;   # sauf . et ..
    chomp(my $taille = qx/du -sh "$_$fic"/); # je calcule la taille
    unlink "$_$fic" if $taille=~/^0/;        # si zéro je supprime
  }
  close REP; # fermeture de handle en cours
}

__END__