use locale; use strict; use Getopt::Std; #Analyse des options our ( $opt_c, $opt_t ); $opt_c = 20; getopt( "c:t:" ); my ( $direction, $distance ); if ( defined ($opt_t) ){ if ( $opt_t =~ /^(G|D)([1-9])$/i ){ $direction = uc($1); $distance = $2; } else { die "Le critère de tri doit être (G|D)(distance) !\n"; } } #Analyse des arguments if ( $#ARGV != 0 ) { die "Usage : $0 [-c taille_contexte] [-t tri] expression\n"; } my $expression = $ARGV[0]; eval { "" =~ /$expression/ }; if ( $@ ne "" ){ die "Erreur dans l'expression régulière !\nDétails : ",$@,"\n"; } #Recherche et construction des contextes my ($max, @contextes); while ( my $ligne = ) { chomp $ligne; $ligne =~ s/\t/ /g; while ( $ligne =~/\b($expression)\b/ig ) { my ( $gauche, $droite ); if ( length($`) < $opt_c ) { $gauche = " " x ( $opt_c - length($`) ) . $`; } else { $gauche = substr( $`, length($`) - $opt_c, $opt_c ); } $droite = substr ($', 0, $opt_c ); push ( @contextes, $gauche."\t".$&."\t".$droite ); if ( length($&) > $max ){ $max = length($&); } } } #Normalisation des contextes for ( my $i = 0 ; $i <= $#contextes ; $i++ ){ if ( $contextes[$i] =~ /^(.*)\t(.*)\t(.*)$/ ){ $contextes[$i] = $1 . "\t" . $2.(" "x($max-length($2)))."\t".$3; } } #Tri et affichage if ( defined($opt_t) ){ @contextes = sort { &critere_tri($a) cmp &critere_tri($b) } @contextes; } print join ( "\n", @contextes ),"\n"; sub critere_tri { my $contexte = shift @_; my ( $c_gauche, $c_droit, $pivot, @tab ); if ( $contexte =~ /^(.*?) ?\t(.*)\t ?(.*)$/ ){ $c_gauche = $1; $pivot = $2; $c_droit = $3; if ( $direction eq "G" ) { @tab = reverse ( split ( / /, $c_gauche ) ); } else { @tab = split ( / /, $c_droit ); } if ( $#tab >= $distance - 1 ){ return $tab[$distance - 1]; } else { return ""; } } }