コンコーダンサーを作る

#!/usr/local/bin/perl

$directory="data"; 	#目的のファイルがあるフォルダの名称
$file="wowcat\.txt"; 	#ファイルの名称。「\.」としてありますが\はなくてもほぼOK
$separator="\\"; 	#パスをつなぐ記号で、機種固有値(UNIX... /  Mac... :)
$in=$directory.$separator.$file; 	#相対パスでファイルを指定

open (FILE, $in) || die "$in\n$!\n"; 	#ファイルオープン
while (<FILE>) { 				#ファイル内のデータ分繰り返し
	push (@array, $_); 		#配列@arrayに格納
}
close FILE;	#ファイルのクローズ

@hit = grep(/\b$word\b/i, @array); 		#iオプションで大文字小文字の区別をなくしてみました
print "sentence ... ", $#hit+1,"\n";		#ヒット数。語の数ではなく文の数が表示されることに注意

#確認
foreach $yoso (@hit) {
  print $yoso;
}

$total=0;
foreach $yoso (@hit) {
  while (1) {
    if ($yoso =~ /\b($word)\b/i) {
      $total++;
      $ephe = $total."_".$1;
      $yoso =~ s/\b$1\b/$ephe/;
    } else {
      last;
    }
  }>
}
print "word ... ", $total, "\n";

$out = "concres\.txt";
$counter = 1;

open (FILE, "> $out") || die "Can't create $out\n$!\n";
foreach $yoso (@hit) {
  while (1) {
    $pre = $counter."_";
    $ephe = $pre."\(".$word."\)";
    if ($yoso =~ /\b($ephe)\b/i) {
      $fst = $`; $ephe = $1; $lst = $';
      $yoso =~ s/$pre//;
      $ephe =~ s/$pre//;
      $lst =~ s/\d+_//g;
      print FILE "$fst\t$ephe\t$lst";
      $counter++;
    } else {
      last;
    }
  }
}
close FILE;
print "end\n";

$fst = $`;
$fst =~ s/\s+$//; #文字列末の空白文字削除
if ($fst =~ /([\w'-]+)$/) { #最後の１語にマッチさせ、$1に格納する条件文
  $mae = $1;
} else {
  $mae = substr($fst, length($fst)-1, 1); #語でない場合、直前の１文字を代入
}
print "match ... $ephe\n";
print "mae ... $mae\n";

$lst = $';
$lst =~ s/^\s+//; #文字列最初の空白文字削除
if ($lst =~ /^([\w'-]+)/) {  #最初の１語にマッチさせ、$1に格納する条件文
  $ato = $1;
} else {
  $ato = substr($lst, 0, 1); #語でない場合、直後の１文字を代入
}
print "ato ... $ato\n\n";

$switch = 0;
print "sort by: 0. no sort  1.target itself  2.before target  3.after target (0, 1, 2, or 3): ";
$ss = <STDIN>;
chop $ss;
if ($ss == 1) {$switch = 1;} elsif ($ss == 2) {$switch = 2;} elsif ($ss == 3) {$switch = 3;}
print "sort $switch\n";

$out = "concres\.txt";
$counter = 1;

foreach $yoso (@hit) {
  while (1) {
    $pre = $counter."_";
    $ephe = $pre.$word;
    if ($yoso =~ /\b($ephe)\b/i) {
      $fst = $`; $ephe = $1; $lst = $';

      $yoso =~ s/$pre//;
      $ephe =~ s/$pre//;
      $lst =~ s/\d+_//;

      $fst =~ s/\s+$//; #文字列末の空白文字削除
      if ($fst =~ /([\w'-]+)$/) {
        $mae = $1;
      } else {
        $mae = substr($fst, length($fst)-1, 1);
      }

      $lst =~ s/^\s+//; #文字列最初の空白文字削除
      if ($lst =~ /^([\w'-]+)/) { #最初の１語にマッチさせ、$1に格納する条件文
        $ato = $1;
      } else {
        $ato = substr($lst, 0, 1); #語でない場合、直後の１文字を代入
      }

#ここがソート種類別の処理
#ソートしたい語を元データの頭にくっつけ、元データとの間を３つのアンダーバー「___」で区切る
#elseの分岐ではこの処理を行わない
      if ($switch == 1) {
          $new_yoso = $ephe."___".$fst."\t".$ephe."\t".$lst;
          push (@new_hit, $new_yoso);
      } elsif ($switch == 2) {
          $new_yoso = $mae."___".$fst."\t".$ephe."\t".$lst;
          push (@new_hit, $new_yoso);
      } elsif ($switch == 3) {
          $new_yoso = $ato."___".$fst."\t".$ephe."\t".$lst;
          push (@new_hit, $new_yoso);
      } else {
          $new_yoso = $fst."\t".$ephe."\t".$lst;
          push (@new_hit, $new_yoso);
      }
      
      $counter++;
    } else {
      last;
    }
  }
}

#$switchが1より大きいときのみソートする
if ($switch > 0) {@new_hit = sort @new_hit;}

#ここがファイル書き出し処理
open (FILE, "> $out") || die "Can't create $out\n$!\n";
foreach $new_yoso (@new_hit) {
  if ($switch > 0) {$new_yoso =~ s/^.+___//;} #頭につけた余分なデータを削除して元に戻す
  print FILE $new_yoso; #書き出し
}
close FILE;
print "end\n";

補足：
純粋にN番目のマッチを見つけるには、以下のようにします。
以下の例では３番目のcatとその前の単語を出力
--

$txt="white cat blue cat red cat yellow cat gray cat";
$n=2;
$counter=0;

while ($txt =~ /([\w'-]+\s+cat)\b/gi) {
	if ($counter++ == $n) {
		print $1,"\n";
		#in this case 'last;' is prohibited
	}
}