Thread Reguläre Ausdrücke suchen
(34 answers)
Opened by Bionerd at 2012-04-18 12:19
Verstehe ich es richtig das immer die gesamte Datei betrachtet werden soll und nicht nur immer eine Zeile pro Datei?
Wenn dem so ist hier mal eine Analyse soweit du sie Beschrieben hast: Code (perl): (dl
)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 #!/usr/bin/perl use strict; use warnings; my $dir='.'; my @motives = ("PO", "OHO", 'G[A-Z]{2}G'); # 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); print "Analyse File $file\n"; my @found=analyse_file($path,\@motives); printf ( qq("%s" and "%s" found in Line %u and Line %u\n),@$_ ) for(@found); } closedir($dh); ######################################################################## sub analyse_file { my $file=shift; my $motives=shift; # Referenz auf Array #die gesamte Datei einlesen my $content=read_file($file); die("File empty!") unless($content); # 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) { # 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{$motive}},$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); # doppelte ausschließen my %double; for my $line1 (@{$match{$motive1}}) { for my $line2 (@{$match{$motive2}}) { next if($double{"$line1-$line2"}++); next if($double{"$line2-$line1"}++); 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; } EDIT: Zeile 59: Etwas Code fehlte. Last edited: 2012-04-19 03:14:58 +0200 (CEST) |