#/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, $
+statusRow);
        $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, $ou
+tPattQty++);
#                    $threadCONSOLE->WriteChar($statString, $threadSta
+tusColumn, $statusRow);
                    $CONSOLE->WriteChar($statString, $threadStatusColu
+mn, $statusRow);
                }
            }
        }
    }
    $outqueue->enqueue(undef);
    $statString = sprintf ("%5s/%-5s.", $inPattQty, $outPattQty);
#    $threadCONSOLE->WriteChar($statString, $threadStatusColumn, $stat
+usRow)
    $CONSOLE->WriteChar($statString, $threadStatusColumn, $statusRow)
    #print "$threadname ended.\n";
}
[download]