Unless I'm embarrasing myself again this has no print statements. (Part of the problem before was that there was a debug message still in my code that I thought I had killed).
I try to use Win32::Console to put all the thread started lines on one row, all the thread ended lines on another row and all the input/output hash counts on another row.
It seems to run fine until the first thread ends. At that point all output stops.
As badly as I did before, I'm sure there's something stupid I'm doing - what is it?
#/usr/bin/perl -w
use strict;
use warnings;
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);
#&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]);
my $startRow = $statusRow + 1;
my $endRow = $startRow + 1;
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
}
#dequeue from the last queue of the chain
my $Solutionref;
my %Solution;
#print "\nresults: \n";
$CONSOLE->WriteChar("\n", 0,$endRow + 1);
$CONSOLE->Write("results: \n");
while ($Solutionref = $DataQueues[$#DataQueues]->dequeue) {
%Solution = %{$Solutionref};
#printKeys (\%Solution);
printSolution (\%Solution);
}
$CONSOLE->Write("\n");
#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";
$CONSOLE->Write($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;
$CONSOLE->WriteChar("$threadname started", $threadStatusColumn,
+ $startRow);
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);
$CONSOLE->WriteChar($statString, $threadStatusColumn, $statusR
+ow);
$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);
$CONSOLE->WriteChar($statString, $threadStatusColu
+mn, $statusRow);
}
}
}
}
$outqueue->enqueue(undef);
$statString = sprintf ("%5s/%-5s.", $inPattQty, $outPattQty);
$CONSOLE->WriteChar($statString, $threadStatusColumn, $statusRow);
#print "$threadname ended.\n";
$CONSOLE->WriteChar("$threadname ended", $threadStatusColumn, $end
+Row);
}
