#!/usr/bin/perl use strict; use warnings; my $dir='.'; my @motives = ("PO", "OHO", 'G[A-Z]{2}G'); my $out_dir='out'; my %anzahl; # Ordner öffnen und durchgehen opendir(my $dh, $dir) or die("Error open $dir,($!)\n"); while(my $file=readdir($dh)) { # Pfad machen. my $path="$dir/$file"; # testen ob es eine Datei ist next unless(-f $path); next if($path!~/\.txt$/); print "Analyse File $file\n"; my @found=analyse_file($path,\@motives); for my $e (@found) { my ($motive1,$motive2)= sort @$e[0,1]; # für die Zusammenfassung $anzahl{join('-!-', $motive1,$motive2)}++; # Ausgabe in Konsole #printf ( qq("%s" and "%s" found in Line %u and Line %u\n),@$e ); # Ausgabe in Datei my $outpath="$out_dir/$motive1$motive2.txt"; if(open(my $fh, '>>', $outpath)) { printf $fh ("%s + %s found in Line %u and Line %u + %s\n", @$e,$file); } else { warn("Error open $outpath ($!)"); } } } closedir($dh); # Zusammenfassung printf ("%s+%s %u\n",split(/-!-/,$_),$anzahl{$_}) for (sort keys(%anzahl)); ######################################################################## sub analyse_file { my $file=shift; my $motives=shift; # Referenz auf Array #die gesamte Datei einlesen my $content=read_file($file); unless($content) { warn("File empty!"); return; } # eine Liste mit den Positionen der Zeileenden erstellen: my @line_ends=find_lineends($content); # alle Suchbegriffe durchgehen und sich alle Positionen merken. my %match; for my $motive (@$motives) { pos($content)=0; while($content=~/($motive)/g) { my $found=$1; # zur aktuellen Postion im String wird die Zeile Bestimmt my $line=calculate_line(\@line_ends,pos($content)); # es wird ein Hash of Arrays erstellt push(@{$match{$found}},$line); } } # Auswertung my @found; my @keys=keys(%match); # jedes Fund mit jedem anderen Kombinieren # doppelte vermeiden for my $p1 (0..$#keys) { my $motive1=$keys[$p1]; for my $p2 ($p1..$#keys) { my $motive2=$keys[$p2]; next if($motive1 eq $motive2 and @{$match{$motive1}}<2); if($motive1 eq $motive2) { my @list=@{$match{$motive1}}; for my $pos1 (0 .. $#list-1) { for my $pos2 ($pos1+1 .. $#list) { push(@found,[$motive1,$motive1,$list[$pos1],$list[$pos2]]); } } } else { for my $line1 (@{$match{$motive1}}) { for my $line2 (@{$match{$motive2}}) { push(@found,[$motive1,$motive2,$line1,$line2]); } } } } } return @found; } sub read_file { my $file=shift; die("ERROR open $file ($!)\n") unless( open(my $handle, '<', $file) ); #zeilenende auf undef setzen local $/=undef; # alles einlesen return <$handle>; } sub calculate_line { my $endings=shift; my $pos=shift; return 0 if($pos<0); return $endings->[-1] if($pos > $endings->[-1]); for my $l (1..$#$endings) { return $l if($pos >= $endings->[$l-1] && $endings->[$l] >= $pos); } return -1; } sub find_lineends { my $content=shift; my @list=(0); my $pos=0; while(( my $p=index($content,"\n",$pos) )>-1) { push(@list,$p); $pos=$p+1; last if($pos>=length($content)); } return @list; }