This version does everything I think I want (for now).
The point is to match CiphetText words (CT) in a cryptogram to plaintext words (pt) in a wordlist. To see it really work, you'll need a copy of Knuth's word list (words.knu). I got it from the ACA web site. The array @aPattHashes is hand coded to both hold the CT and a regular expression pattern template that represents the CT. I launch one thread per CT word.
Each thread has an input queue and an output queue. The data is passed as an anonymous hashref of CT alphabet to pt alphabet. Initially an empty anonymous hashref is put on the 0th queue. undef marks the end of data on the queue.
Each thread takes a solution which represents a set of "results so far" off the input queue, munges the pattern template into a pattern and looks for matches. Each match is tested for consistency and if there is no conflict, it's results are added to the input hash and put on the output queue.
In the end, results are read off the output queue and the array of CT words are substituted for each valid solution and printed.
I thought all of the above was working and am embarrassed by the mess I originally posted.
It runs long and I thought it would be cool to report the progress somehow. Below is a version of the code which follows each thread showing the number of hashes read from the input queue followed by the number written to the output queue. When complete, the same thing is written again with a trailing period.
This version uses only print statements for output. It would be cool to overwrite one status line with the thread stats until the final results are ready. The next post will show that with Win32::Console and ask the problem again.
#/usr/bin/perl -w
use strict;
use warnings;
use threads;
use threads::shared;
use Thread::Queue;
use Hash::Util qw(lock_keys unlock_keys
lock_value unlock_value
lock_hash unlock_hash
hash_seed);
my $i; #looper
######################################################################
+###################
#
# data structure is an array of hashes
# each element in the array has all the info needed for a thread to
+work
# hash keys are:
# 'CT' contins CipherText
# 'Pattern' contains a string that will be turned into a pattern
+ to look for words in a wordlist
# 'Solutions' contain dummy answers used for stub testing - not
+needed in steady state
# hashes are locked - this data need never change and if it does, th
+at's a problem
#
######################################################################
+###################
my @aPattHashes = ( # single element hashes that associate CT with pat
+terns (from ART) #
{'CT'=>'LBCJC',
+ #
'Pattern'=>'($L)(?!\1)($B)(?!\1)(?!\2)($C)(?!\1)(?!\2)(?!\3)($J)\3
+', #
'Solutions'=>{('there','where','wasps','suede')}
+ #
},
+ #
{'CT'=>'ABCJC',
+ #
'Pattern'=>'($A)(?!\1)($B)(?!\1)(?!\2)($C)(?!\1)(?!\2)(?!\3)($J)\3
+', #
'Solutions'=>{('there','where','wasps','suede')}
+ #
},
+ #
{'CT'=>'ABC',
+ #
'Pattern'=>'($A)(?!\1)($B)(?!\1)(?!\2)($C)',
+ #
'Solutions'=>{('the','are','who','zap')}
+ #
},
+ #
{'CT'=>'VJC',
+ #
'Pattern'=>'($V)(?!\1)($J)(?!\1)(?!\2)($C)',
+ #
'Solutions'=>{('the','are','who','zap')}
+ #
}
+ #
);
+ #
for ($i=0; $i <= $#aPattHashes; $i++) {
+ #
lock_hash(%{$aPattHashes[$i]});
+ #
}
+ #
######################################################################
+###################
#set up dictionary
my $words = '';
open (WORDS, 'words.knu');
{
local $/;
$words = <WORDS>;
}
close WORDS;
my @wordlist = split(/\n/,$words);
my @DataQueues; #There are n+1 queues (mileposts vs. miles).
for ($i = 0; $i <= $#aPattHashes + 1; $i++) {
$DataQueues[$i] = Thread::Queue->new;
}
my @aThreads; # one thread per pattern.
for ($i=0; $i <= $#aPattHashes ; $i++) {
# each thread needs code to do, an input queue, an out
+put queue, threadPattHash
$aThreads[$i] = threads->new(\&wordfinder, $DataQueues[$i], $DataQu
+eues[$i+1], $aPattHashes[$i], $i);
}
#put first (empty) solution on the first queue
my $hrefSolution = &share({});
$DataQueues[0]->enqueue($hrefSolution);
$DataQueues[0]->enqueue(undef);
#wait for threads to exit.
for ($i=0; $i<=$#aThreads; $i++) {
$aThreads[$i]->join;
#print "thread $i ended \n"; # this will be detected in the order
+joined, not the order the threads end
}
#dequeue from the last queue of the chain
my $Solutionref;
my %Solution;
print "\nresults: \n";
while ($Solutionref = $DataQueues[$#DataQueues]->dequeue) {
%Solution = %{$Solutionref};
#printKeys (\%Solution);
printSolution (\%Solution);
}
print "\n";
sub printKeys {
my $href = shift;
print "\nCT: ";
print(($_).' ') foreach (sort keys %{$href});
print "\npt: ";
print(($$href{$_}).' ') foreach (sort keys %{$href});
print "\n";
}
sub printSolution {
my $href = shift;
my $CT='';
my $pt='';
for ($i=0; $i<=$#aPattHashes; $i++) {
$CT = $CT.sprintf $aPattHashes[$i]{'CT'}.' ';
$pt = $CT;
}
foreach (keys %{$href}) {
$pt =~ s/$_/$$href{$_}/g;
}
#print "\n";
#print $CT."\n";
print $pt."\n";
}
sub template2patt {
my ($href, $template) = @_;
my $patt = $template;
foreach ( keys %{$href} ){
$patt =~ s/\$$_/$$href{$_}/g;
}
$patt =~ s/\$[A-Z]/\[a-z\]/g;
return $patt;
}
sub compare {
#direction matters?
my ($hrefA, $hrefB) = @_;
my @Avalues = values (%{$hrefA});
my @Bvalues = values (%{$hrefB});
my $true = 1;
my $false = !$true;
my $result = $true;
my $k;
foreach $k (keys(%{$hrefA})) {
if (exists $hrefB->{$k}) {
if ($hrefA->{$k} ne $hrefB->{$k}) { # same key, different
+values
$result = $false;
last;
}
} else {
if (grep (/$hrefA->{$k}/ , ((),values (%{$hrefB}))) ) { #s
+ame values, different keys
$result = $false;
last;
}
}
}
if ($result) {
foreach $k (keys(%{$hrefB})) {
if (exists $hrefA->{$k}) { # <<< not sure I need to check
+this both directions.
if ($hrefB->{$k} ne $hrefA->{$k}) { # same key, differ
+ent values
$result = $false;
last;
}
} else { # <<< but I definitely need to
+check this both directions
if (grep (/$hrefB->{$k}/, values (%{$hrefA}) ) ){ #sam
+e values, different keys
$result = $false;
last;
}
}
}
}
return $result ;
}
sub wordfinder {
my ($inqueue, $outqueue, $threadPattHash, $threadNum) = @_;
my $threadCT = $$threadPattHash{CT};
my @CTchars = split(//,$threadCT);
my $threadname = $threadCT;
my $patternString = $$threadPattHash{Pattern};
my $inPattQty = 0;
my $outPattQty = 0;
my $statString;
my $threadStatusColumn = $threadNum * 12;
print ' 'x$threadStatusColumn, "$threadname started.\n";
my $pattern;
my $word;
my $inSolutionref;
my %inSolution;
my $matchSolutionref;
my %matchSolution;
my $outSolutionref;
my %outSolution;
while ($inSolutionref = $inqueue->dequeue) {
$statString = sprintf ("%5s/%-5s", ++$inPattQty, $outPattQty);
print ' 'x$threadStatusColumn, $statString, "\n";
$pattern = template2patt ($inSolutionref, $patternString);
%inSolution = %{$inSolutionref};
foreach $word (@wordlist) {
if ($word =~m/^${pattern}$/) {
chomp($word);
$outSolutionref = &share({});
%{$matchSolutionref} = map { $CTchars[$_] => (split(//
+,$word))[$_] } (0..$#CTchars);
if ( compare($inSolutionref, $matchSolutionref) ) {
%$outSolutionref = (%inSolution);
foreach (keys(%{$matchSolutionref})) { $outSolutio
+nref->{$_} = $matchSolutionref->{$_} };
#printSolution $outSolutionref;
$outqueue->enqueue($outSolutionref);
$statString = sprintf ("%5s/%-5s", $inPattQty, ++$
+outPattQty);
print ' 'x$threadStatusColumn, $statString, "\n";
}
}
}
}
$outqueue->enqueue(undef);
$statString = sprintf ("%5s/%-5s.", $inPattQty, $outPattQty);
print ' 'x$threadStatusColumn, $statString, "\n";
print ' 'x$threadStatusColumn, "$threadname ended.\n";
}
