#!/usr/bin/perl use strict; use warnings; # Mögliche Kollokationen (statische Vorgabe) my %colls = ( 0 => 'vor' , 1 => 'nach' , 2 => 'vor oder nach' ); # Das Korpus my $txt = 'Lorem ipsum dolor sit amet, consetetur sadipscing elitr, sed diam nonumy eirmod tempor invidunt ut labore et dolore magna aliquyam erat, sed diam voluptua.'; # Der Suchstring (Benutzereingabe) my $such = "sed diam"; # Die Textumgebungen (Benutzereingabe) mit Abständen (Anzahl Wörter im Zwischenraum) und Kollokationen (s.o. %colls) my %kontexts = ( "sit amet" => {'dist' => 3, 'coll' => 1} , "eirmod" => {'dist' => 2, 'coll' => 2} , "Lorem" => {'dist' => 8, 'coll' => 0} ); for my $ktxt (keys %kontexts) { my $dist = $kontexts{$ktxt}->{dist}; my $coll = $kontexts{$ktxt}->{coll}; my ($s1, $s2) = ($such, $ktxt); print "Suche '$such' bis zu $dist Textsegmente $colls{$coll} '$ktxt'\n"; my $hit; for (1..($coll ? $coll : 1)) { ($s1, $s2) = ($s2, $s1) if $coll; $hit = $1 if $txt =~ /(\b$s1\W*(?:\w+\W+){0,$dist}$s2\b)/i; last if $hit; } if ($hit) { print " Treffer: '$hit'\n"; } else { print " Kein Treffer\n"; } }