First variant of my full code. my $CONSOLE is in main and my $threadCONSOLE is in the thread.
#/usr/bin/perl -w
use strict;
use threads;
use threads::shared;
use Thread::Queue;
use Win32::Console;
use Hash::Util qw(lock_keys unlock_keys
lock_value unlock_value
lock_hash unlock_hash
hash_seed);
my $i; #looper
my $CONSOLE = Win32::Console->new(STD_OUTPUT_HANDLE);
$CONSOLE->Title("This is a title");
#&share($CONSOLE);
#$CONSOLE->Cls;
my $CURRENT_ROW = 3;
my $BOTTOM_ROW = 8;
my @consoleInfo = $CONSOLE->Info();
my $statusRow = min ( $consoleInfo[$CURRENT_ROW], $consoleInfo[$BOTTOM
+_ROW]);
sub min {
my ($a,$b) = @_;
return ($a<=$b?$a:$b);
}
######################################################################
+###################
#
# 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
}
$CONSOLE->Free();
#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} != $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 (keys(%{$hrefB})) {
if (exists $hrefA->{$k}) { # <<< not sure I need to check
+this both directions.
if ($hrefB->{$k} != $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}) ) ){ #same
+values, different keys
print 'same values, different keys: '."$k".'->'."$
+hrefB->{$k}\n";
$result = $false;
last;
}
}
}
}
return $result ;
}
sub wordfinder {
my ($inqueue, $outqueue, $threadPattHash, $threadNum) = @_;
my $threadCT = $$threadPattHash{CT};
my @CTchars = split(//,$threadCT);
my $threadname = $threadCT;
#print "$threadname started.\n";
my $patternString = $$threadPattHash{Pattern};
my $inPattQty = 0;
my $outPattQty = 0;
my $statString;
my $threadStatusColumn = $threadNum * 12;
my $threadCONSOLE = Win32::Console->new(STD_OUTPUT_HANDLE);
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);
$threadCONSOLE->WriteChar($statString, $threadStatusColumn, $s
+tatusRow);
$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, $ou
+tPattQty++);
$threadCONSOLE->WriteChar($statString, $threadStat
+usColumn, $statusRow);
}
}
}
}
$outqueue->enqueue(undef);
$statString = sprintf ("%5s/%-5s.", $inPattQty, $outPattQty);
$threadCONSOLE->WriteChar($statString, $threadStatusColumn, $statu
+sRow)
#print "$threadname ended.\n";
}
This is to help out in a cryptography hobby. 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.
Put it in the same folder and run this. The first word pattern will have (on my word list) 177 matches. After that, the output stops and looks like this:
This show the first thread taking one solution off it's input queue, putting 177 on it's output queue and stopping (the period). The second thread only got 3 Solutions out of those 177 before all output stopped (after the first thread ended).
If I remove all references to Win32::Console, it proceeds to completion and shows a list of possible solutions for this four word cryptogram.