pechkin | Оно работает

Хотя и медленно
#!/perl -w

 #!/perl -w

my $ms_file = $ARGV[0];
my $bible_dir = "t:\\bible";

my @books =
(
    'Genesis',
    'Exodus',
    'Leviticus',
    'Numbers',
    'Deuteronomy',
    'Joshua',
    'Judges',
    'Ruth',
    'Samuel1',
    'Samuel2',
    'Kings1',
    'Kings2',
    'Chronicles1',
    'Chronicles2',
    'Ezra',
    'Nehemiah',
    'Esther',
    'Job',
    'Psalms',
    'Proverbs',
    'Ecclesiastes',
    'SongOfSongs',
    'Isaiah',
    'Jeremiah',
    'Lamentations',
    'Ezekiel',
    'Daniel',
    'Hosea',
    'Joel',
    'Amos',
    'Obadiah',
    'Micah',
    'Jonah',
    'Nahum',
    'Habbakuk',
    'Zephaniah',
    'Haggai',
    'Zechariah',
    'Malachi',
    'Matthew',
    'Mark',
    'Luke',
    'John',
    'Acts',
    'Romans',
    'Corinthians1',
    'Corinthians2',
    'Galatians',
    'Ephesians',
    'Philippians',
    'Colossians',
    'Thessalonians1',
    'Thessalonians2',
    'Timothy1',
    'Timothy2',
    'Titus',
    'Philemon',
    'Hebrews',
    'James',
    'Peter1',
    'Peter2',
    'John1',
    'John2',
    'John3',
    'Jude',
    'Revelation',
);

open(MS, "<$ms_file") or die("Failed to open $ms_file: $!\n");

my @names = ();
foreach my $line ()
{
    next if ($line !~ /^Let ([A-Z]\w+) /);
    push(@names, $1);
}

#stage 1
my %stat = ();
my %names_found = ();
foreach my $book (@books)
{
    warn("$book:\n");
    open(FILE, "<$bible_dir/$book.txt") or die("Failed to open $book.txt: $!\n");
    foreach my $line ()
    {
	foreach my $name (@names)
	{
	    next if (defined($stat{$book}{$name}));
	    if ($line =~ /\b$name\b/g)
	    {
		$stat{$book}{$name} = 1;
		$names_found{$name} = $book;
#		warn("\t$name\n");
	    }
	}	
    }
    warn("Total: ", scalar(keys(%{$stat{$book}})), " names\n");
}		

#stage 2
#sort books in descending order by number of names encountered
my @res = reverse(sort({scalar(keys(%{$stat{$a}})) <=> scalar(keys(%{$stat{$b}}))} keys(%stat)));

#delete from books with less names encountered names from the books
#with more names encountered
for (my $i = 0; $i < scalar(@res); $i++)
{
    my @names_to_delete = keys(%{$stat{$res[$i]}});
    for (my $j = $i + 1; $j < scalar(@res); $j++)
    {
	my $lesser_book = $stat{$res[$j]};
	map({delete($lesser_book->{$_}) if (exists($lesser_book->{$_}))} @names_to_delete);

	#remove book with no names left from the list
	delete($stat{splice(@res, $j, 1)}) if (0 == scalar(keys(%$lesser_book)));
    }
	
    #resort the books
    @res = reverse(sort({scalar(keys(%{$stat{$a}})) <=> scalar(keys(%{$stat{$b}}))} keys(%stat)));
}

#find names not found in any book
my %names_not_found = map {$_ => 1} @names;
map(delete($names_not_found{$_}), keys(%names_found));
my $q_not_found = keys(%names_not_found);

#print statistics
my $total = $q_not_found;
map({$total += keys(%{$stat{$_}})} @res);
foreach my $book (@books)
{
    if (!defined($stat{$book}))
    {
	print("$book\t0\n");
    }
    else
    {
	my $q = keys(%{$stat{$book}});
#    printf("%s\t%d\t%d%%\n", $book, $q, $q / $total * 100);
	printf("%s\t%d\n", $book, $q);
#    map(warn("\t$_\n"), sort(keys(%{$stat{$book}})));
    }
}
print("not found\t$q_not_found\t", $q_not_found / $total * 100, "%\n");
map(warn("\t$_\n"), sort(keys(%names_not_found)));
Оно работает

всегда перся от перловского синтаксиса...
