REGEXP perl

#     
# ... => \x01     
# *   => \x02     
# ?   => \x03     
# . => \.     
# \x01 => .*?     
# \x02 => .*     
# \x03 => \.     
# include => (?!...)     
# exclude => (?=...)     
# global => ^(?:expr1|expr2...)$     
sub genere_regexp     
  {     
    my @regexps ;     
    my @DATA ;     
    open(DATA,"/tmp/IncludeExclude.log");    Ici je lis le fichiers TSM   
    foreach my $modele (<DATA>)     
      {     
        next if $modele !~ /^(Excl(?:ude)?|Include)\s+(\S+)\s+(\S+)/ ;     
        my $mode = $1 ;     
        my $function = $2 ;     
        $modele = $3 ;     
        # Transforme les metacaracteres TSM pour les proteger, on les     
        # retraitera plus tard     
        $modele =~ s/\.\.\./\x01/g ;       
        $modele =~ s/\*/\x02/g ;     
        $modele =~ s/\?/\x03/g ;     

        # Protege les metacaracteres de regexp restants pour leur retirer leur     
        # caractere meta     
        $modele =~ s/\./\\./g ;     

        # Convertit les metacarateres TSM en leur equivalent regexp. Ne pas     
        # oublier qu'ils ont deja  change© de format pour les proteger     
        $modele =~ s/\x01/.*?/g ;     
        $modele =~ s!\x02![^/]*!g ;     
        $modele =~ s!\x03![^/]!g ;     

        if ($mode eq 'Include')                 # TSM Include /.../*     
          {     
            $modele = "(?!$modele)" ;     
          }     
        elsif (($function eq 'Filespace')||($function eq 'Directory'))  # TSM Exclude.fs or Exclude.dir     
          {     
            $modele = "$modele(?=/.*)?" ;   Exclude des Filesystem ou directories    
          }     
        else     
          {     
            $modele = "$modele(?=/.*)?" ;     
          }     
        else     
          {     
            $modele = "(?=$modele)" ;           # TSM Exclude /myfile ou Exclude /.../*.dbf     
          }     
        push(@regexps, qr($modele)) ;     
      }     
    return sprintf('^(?:%s)$', join('|', @regexps)) ;     
    close (DATA)     
  }     

   
sub main     
{     
  my @dirs = @_ ;     

  $REGEXP = &genere_regexp ;   Appel creation de la REGEXP   
  print $REGEXP, "\n" ;   Affichage de la REGEXP   
  foreach my $dir (@dirs)     pour chaque argument en ligne de commade /orcrman/dbf06    
    {     
      $TOTALMB = 0 ;     
      $TOTALFI = 0 ;     
      find(\&compte, $dir) ;   le find parcours les rerpertoires et appel la fonction compte    
      printf("Total Size=%lu\n", $TOTALMB) ;   Affichage du resultat   
      printf("Total File=%lu\n", $TOTALFI) ;     
    }     
  return 0 ;     
}     

sub compte     
  {     
 les lignes dessous sont pour debuger   
#    printf("[%s] [%s]\n", $_, $File::Find::name) ;     
        printf("variable dollar=%s\n", $_) ;     
        my $f = $File::Find::name ;     
        printf("variable f=%s\n", $f) ;     
#       $f =~ s/[0-9][0-9]/\x01/g ;     
#       $f =~ s/[0-9]/\x01/g ;     
        printf("variable f after modif=%s\n", $f) ;     
        return if $f =~ !/$REGEXP/o ;  filtre par REGEXP, le /o c'est pour eviter de la recharger à chaque fois   
si ca match on passe au fichier suivant, sinon on continu et on additionne   
        #return if $File::Find::name =~ !/$REGEXP/o ;     
#    printf("%lu\n", -s $_) ;     
    if ( ! -l $_ )   si ce n'est pas un lien symbolique   
      {     
        printf("[%s] [%s] [%d]\n", $_, $File::Find::name, -s $_) ;     
        $TOTALMB += -s $_ ;   Addtion volumétrie   
        $TOTALFI += 1 ;    Ajout 1 aux nombre de fichiers grades   
        printf("##################################################Total Size keep=%lu\n", $TOTALMB) ;     
      }     
  }     

        else      
          {      
            $modele = "(?=$modele)" ;           # TSM Exclude /myfile ou Exclude /.../*.dbf      
          } 

$modele = "(?=$modele)" ;

#!/usr/bin/perl   

use strict ;   
use warnings ;   
  
exit (&main(@ARGV) || 0) ;   

sub main   
{ my @ARREG = &genere_regexp ; 
   
  my $AA = "/orcrman/dbf06/APPLI1/data/audit_1.dbf" ; 
  my $BB = "/orcrman/dbf06/APPLI1/data/A_OTHER_D.dbf" ; 
  my $CC = "/orcrman/dbf06/PLOPLO1/data/audit_1.ntf" ; 
  my $DD = "/orcrman/dbf06/PLOPLO1/data/A_OTHER_D.ntf" ; 
   
  foreach my $RR (join('|',($ARREG[0],$ARREG[2])), 
      join('|',($ARREG[1],$ARREG[3])), 
      sprintf('^(?:%s)$', join('|',($ARREG[0],$ARREG[2]))), 
      sprintf('^(?:%s)$', join('|',($ARREG[1],$ARREG[3])))) 
 { 
 foreach my $zz ($AA,$BB,$CC,$DD) 
  { 
  print "\n\$RR == $RR\n" ; 
  if ($zz =~ /$RR/) 
   {print "$zz\t\tMATCHE avec \$RR\n";} 
  else 
   {print "$zz\t\tNE MATCHE PAS avec \$RR\n";} 
  } 
 print "---------------\n"; 
 } 
  
  print "\n\n^(?:(?-xism:(?=/.*?/[^/]*\\.dbf)))\$" ; 
  
  return 0 ;   
}   
  

sub genere_regexp   
  {   
    my @recueil ; 
    my @DATA ;   
    open(DATA,"eee.txt");   
    foreach my $modele (<DATA>)   
      { 
  print "\n----------------------------------------------------------------\n"; 
        next if $modele !~ /^(Excl(?:ude)?|Include)\s+(\S+)\s+(\S+)/ ; 
        my $mode = $1 ;   
  print "\$mode== $mode\n"; 
        my $function = $2 ;  
  print "\$function== $function\n"; 
        $modele = $3 ;  
  print "\$modele \$3 == $modele\n"; 
  next if $modele !~ /(?:\/\*\.(?:ntf|dbf))$/ ; 
  print "==============\n ** GOT ONE **\n"; 
   
        # Transforme les metacaractères TSM pour les protéger, on les   
        # retraitera plus tard   
        $modele =~ s/\.\.\./\x01/g ;   
        $modele =~ s/\*/\x02/g ;   
        $modele =~ s/\?/\x03/g ;   
  print "\$modele traitée 1 == $modele\n"; 

        # Protège les métacaractères de regexp restants pour leur retirer leur   
        # caractère méta   
        $modele =~ s/\./\\./g ;   
  print "\$modele traitée 2 == $modele\n"; 
   
        # Convertit les métacaratères TSM en leur équivalent regexp. Ne pas   
        # oublier qu'ils ont déjà changé de format pour les protéger   
        $modele =~ s/\x01/.*?/g ;   
        $modele =~ s!\x02![^/]*!g ;   
        $modele =~ s!\x03![^/]!g ;  
  print "\$modele traitée 3 ==  $modele\n";   

        if ($mode eq 'Include')                 # TSM Include /.../*   
          {   
            $modele = "(?!$modele)" ;  
   print "\$modele si \$mode eq 'Include' == $modele\n"; 
          }   
        elsif (($function eq 'Filespace')||($function eq 'Directory'))  # TSM Exclude.fs or Exclude.dir   
          {   
            $modele = "$modele(?=/.*)?" ;   
   print "\$modele si \$function eq 'Filespace' ou 'Directory' == $modele\n"; 
          }   
        else   
          {   
            $modele = "($modele)" ;           # TSM Exclude /myfile ou Exclude /.../*.dbf  
   print "\$modele si else   == $modele\n"; 
          } 
  print "\n" ; 
  push(@recueil,$modele) ; 
  push(@recueil,qr($modele)) ; 
      }  

 print "\$recueil[0] == ",$recueil[0] , "\n" ; 
 print "\$recueil[1] == ",$recueil[1] , "\n" ; 
 print "\$recueil[2] == ",$recueil[2] , "\n" ; 
 print "\$recueil[3] == ",$recueil[3] , "\n" ; 

  
 return @recueil ; 
    close (DATA)   
  }   

 

  push(@recueil,$modele) ; 
  push(@recueil,qr($modele)) ;

sub main
{
  my @dirs = @_ ;
  $RR = &genere_regexp ;
  print $RR, "\n" ;
  foreach my $zz (@dirs)
  {
    $TOTALMB = 0 ;
    $TOTALFI = 0 ;
    find(\&compte, $zz) ;
    printf("Total Size=%lu\n", $TOTALMB) ;
    printf("Total File=%lu\n", $TOTALFI) ;
  }
  return 0 ;
}

my $count ;
        for ($count = 0; $count <= $i; $count++)
          {
                print "\$recueil[$count] == ",$recueil[$count] , "\n" ;

                my $CREX (join('|',($CREX,$recueil[$count])),sprintf('^(?:%s)$',($CREX,$recueil[$count])) 
          }
        print $CREX, "\n" ;
        return  $CREX ;

if ($mode eq 'Include')                 # TSM Include /.../*
          {
            $modele = "(?!$modele)" ;
          }
        elsif (($function eq 'Filespace')||($function eq 'Directory'))  # TSM Exclude.fs or Exclude.dir
          {
            $modele = "$modele/.*?/[^/]*" ;
            #$modele = "$modele(?=/.*)?" ;
          }
        else
          {
            $modele = "($modele)" ;           # TSM Exclude /myfile ou Exclude /.../*.dbf
          }
          push(@recueil,qr($modele)) ;
          return sprintf('^(?:%s)$', join('|', @recueil)) ;
          close (DATA) ;