Avec Perl, comment puis-je afficher le contexte autour d'un terme de recherche dans les résultats de recherche?

Question

J'écris un script Perl qui recherche un terme dans de grandes parties de texte. Ce que je voudrais afficher à l’utilisateur est un petit sous-ensemble du texte autour du terme recherché, afin que l’utilisateur puisse définir le contexte dans lequel ce terme est utilisé. Les résultats de recherche Google sont un bon exemple de ce que j'essaie d'accomplir. Le contexte de votre terme de recherche est affiché sous le titre du lien.

Ma recherche de base utilise ceci:

if ($text =~ /$search/i ) {
    print "${title}:${text}\n";
}

($ title contient le titre de l'élément dans lequel le terme de recherche a été trouvé) C’est trop, car parfois, $ text contiendra des centaines de lignes de texte.

Cela va s'afficher sur le Web, je pourrais donc simplement fournir le titre sous forme de lien vers le texte, mais il n'y a pas de contexte pour l'utilisateur.

J'ai essayé de modifier mon expression régulière pour capturer 4 mots avant et 4 mots après le terme de recherche, mais des problèmes se sont posés si le terme de recherche se trouvait au tout début ou à la fin de $ text.

Quel serait un bon moyen d'accomplir cela? J'ai essayé de chercher sur CPAN parce que je suis sûr que quelqu'un a un module pour cela, mais je ne peux pas trouver les bons termes à rechercher. Je voudrais aimer le faire sans modules si possible, car il est très difficile d’installer des modules ici. Quelqu'un a-t-il des idées?

Answer 1

Votre tentative initiale de 4 mots avant / après n'était pas trop éloignée.

Essayez:

if ($text =~ /((\S+\s+){0,4})($search)((\s+\S+){0,4})/i) {
    my ($pre, $match, $post) = ($1, $3, $4);
    ...
}

Answer 2

Vous pouvez utiliser $ et $ 'pour obtenir la chaîne avant et après la correspondance. Puis tronquez ces valeurs de manière appropriée. Mais comme le fait remarquer blixtor, shlomif a raison de suggérer d'utiliser @ + et @ - pour éviter la pénalité de performance imposée par $ et # '-

$foo =~ /(match)/;

my $match = $1;
#my $before = 
 Vous pouvez utiliser $  et $ 'pour obtenir la chaîne avant et après la correspondance. Puis tronquez ces valeurs de manière appropriée. Mais comme le fait remarquer blixtor, shlomif a raison de suggérer d'utiliser  @ +  et  @ -  pour éviter la pénalité de performance imposée par $  et # '- 

;
#my $after = ;
my $before = substr($foo, 0, $-[0]);
my $after =  substr($foo, <*>[0]);

$after =~ s/((?:(?:\w+)(?:\W+)){4}).*/$1/;
$before = reverse $before;                   # reverse the string to limit backtracking.
$before =~ s/((?:(?:\W+)(?:\w+)){4}).*/$1/;
$before = reverse $before;

print "$before -> $match <- $after\n";

Answer 3

Je suggérerais d'utiliser les paramètres de position - @ + et @ - (voir perldoc perlvar) pour trouver la position dans la chaîne de la correspondance et combien il en faut.

Answer 4

Vous pouvez essayer les solutions suivantes:

if ($text =~ /(.*)$search(.*)/i ) {

  my @before_words = split ' ', $1;
  my @after_words = split ' ',$2;

  my $before_str = get_last_x_words_from_array(@before_words);
  my $after_str = get_first_x_words_from_array(@after_words); 

  print $before_str . ' ' . $search . ' ' . $after_str;

}

Certains codes ont évidemment été omis, mais cela devrait vous donner une idée de l'approche.

En ce qui concerne l'extraction du titre ... je pense que cette approche ne se prête pas très bien à cela.