in reply to Re^3: multi-threaded win32::console
in thread multi-threaded win32::console
Third Variant of my full code. There is no Win32::Console; just normal print statements.
#/usr/bin/perl -w use strict; 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} != $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 $pattern; my $word; my $inSolutionref; my %inSolution; my $matchSolutionref; my %matchSolution; my $outSolutionref; my %outSolution; while ($inSolutionref = $inqueue->dequeue) { $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); } } } } $outqueue->enqueue(undef); print "$threadname ended.\n"; }
with the following output:
C:\chas_sandbox>test.pl LBCJC started. ABCJC started. ABC started. VJC started. LBCJC ended. ABCJC ended. ABC ended. VJC ended. results: aided bided bid fed aided bided bid led aided bided bid med aided bided bid red aided bided bid wed aided hided hid bed aided hided hid fed aided hided hid led aided hided hid med aided hided hid red aided hided hid wed aided sided sid bed aided sided sid fed aided sided sid led aided sided sid med aided sided sid red aided sided sid wed aided tided tid bed aided tided tid fed aided tided tid led aided tided tid med aided tided tid red aided tided tid wed airer firer fir her airer firer fir mer airer firer fir per airer firer fir ser airer firer fir ter barer carer car her barer carer car mer barer carer car per barer carer car ser barer carer car ter barer farer far her barer farer far mer barer farer far per barer farer far ser barer farer far ter barer parer par her barer parer par mer barer parer par ser barer parer par ter bases gases gas les bases gases gas yes bayly gayly gay fly bayly gayly gay ply bayly gayly gay sly bided aided aid fed bided aided aid led bided aided aid med bided aided aid red bided aided aid wed bided hided hid fed bided hided hid led bided hided hid med bided hided hid red bided hided hid wed bided sided sid fed bided sided sid led bided sided sid med bided sided sid red bided sided sid wed bided tided tid fed bided tided tid led bided tided tid med bided tided tid red bided tided tid wed boded coded cod fed boded coded cod led boded coded cod med boded coded cod red boded coded cod wed carer barer bar her carer barer bar mer carer barer bar per carer barer bar ser carer barer bar ter carer farer far her carer farer far mer carer farer far per carer farer far ser carer farer far ter carer parer par her carer parer par mer carer parer par ser carer parer par ter cases bases bas les cases bases bas yes cases gases gas les cases gases gas yes casts lasts las its casts pasts pas its coded boded bod fed coded boded bod led coded boded bod med coded boded bod red coded boded bod wed darer barer bar her darer barer bar mer darer barer bar per darer barer bar ser darer barer bar ter darer carer car her darer carer car mer darer carer car per darer carer car ser darer carer car ter darer farer far her darer farer far mer darer farer far per darer farer far ser darer farer far ter darer parer par her darer parer par mer darer parer par ser darer parer par ter direr airer air her direr airer air mer direr airer air per direr airer air ser direr airer air ter direr firer fir her direr firer fir mer direr firer fir per direr firer fir ser direr firer fir ter dryly wryly wry fly dryly wryly wry ply dryly wryly wry sly dusts busts bus its easts lasts las its easts pasts pas its faded laded lad bed faded laded lad med faded laded lad red faded laded lad wed faded waded wad bed faded waded wad led faded waded wad med faded waded wad red farer barer bar her farer barer bar mer farer barer bar per farer barer bar ser farer barer bar ter farer carer car her farer carer car mer farer carer car per farer carer car ser farer carer car ter farer parer par her farer parer par mer farer parer par ser farer parer par ter fasts lasts las its fasts pasts pas its firer airer air her firer airer air mer firer airer air per firer airer air ser firer airer air ter fuses buses bus les fuses buses bus yes gases bases bas les gases bases bas yes gasps hasps has ups gasps wasps was ups gayly bayly bay fly gayly bayly bay ply gayly bayly bay sly gusts busts bus its hasps gasps gas ups hasps wasps was ups hided aided aid bed hided aided aid fed hided aided aid led hided aided aid med hided aided aid red hided aided aid wed hided bided bid fed hided bided bid led hided bided bid med hided bided bid red hided bided bid wed hided sided sid bed hided sided sid fed hided sided sid led hided sided sid med hided sided sid red hided sided sid wed hided tided tid bed hided tided tid fed hided tided tid led hided tided tid med hided tided tid red hided tided tid wed hirer airer air mer hirer airer air per hirer airer air ser hirer airer air ter hirer firer fir mer hirer firer fir per hirer firer fir ser hirer firer fir ter hosts costs cos its jaded faded fad bed jaded faded fad led jaded faded fad med jaded faded fad red jaded faded fad wed jaded laded lad bed jaded laded lad fed jaded laded lad med jaded laded lad red jaded laded lad wed jaded waded wad bed jaded waded wad fed jaded waded wad led jaded waded wad med jaded waded wad red juror furor fur nor juror furor fur tor juror furor fur xor kabob nabob nab cob kabob nabob nab fob kabob nabob nab gob kabob nabob nab hob kabob nabob nab job kabob nabob nab lob kabob nabob nab mob kabob nabob nab rob kabob nabob nab sob laded faded fad bed laded faded fad med laded faded fad red laded faded fad wed laded waded wad bed laded waded wad fed laded waded wad med laded waded wad red lasts pasts pas its liege siege sie age lurer curer cur her lurer curer cur mer lurer curer cur per lurer curer cur ser lurer curer cur ter lusts busts bus its masts lasts las its masts pasts pas its muses buses bus les muses buses bus yes musts busts bus its niece piece pie ace oases bases bas les oases bases bas yes oases gases gas les oases gases gas yes oasis basis bas his oasis basis bas vis parer barer bar her parer barer bar mer parer barer bar ser parer barer bar ter parer carer car her parer carer car mer parer carer car ser parer carer car ter parer farer far her parer farer far mer parer farer far ser parer farer far ter pasts lasts las its posts costs cos its purer curer cur her purer curer cur mer purer curer cur ser purer curer cur ter rasps gasps gas ups rasps hasps has ups rasps wasps was ups rusts busts bus its sided aided aid bed sided aided aid fed sided aided aid led sided aided aid med sided aided aid red sided aided aid wed sided bided bid fed sided bided bid led sided bided bid med sided bided bid red sided bided bid wed sided hided hid bed sided hided hid fed sided hided hid led sided hided hid med sided hided hid red sided hided hid wed sided tided tid bed sided tided tid fed sided tided tid led sided tided tid med sided tided tid red sided tided tid wed siege liege lie age surer curer cur her surer curer cur mer surer curer cur per surer curer cur ter tided aided aid bed tided aided aid fed tided aided aid led tided aided aid med tided aided aid red tided aided aid wed tided bided bid fed tided bided bid led tided bided bid med tided bided bid red tided bided bid wed tided hided hid bed tided hided hid fed tided hided hid led tided hided hid med tided hided hid red tided hided hid wed tided sided sid bed tided sided sid fed tided sided sid led tided sided sid med tided sided sid red tided sided sid wed vases bases bas les vases bases bas yes vases gases gas les vases gases gas yes waded faded fad bed waded faded fad led waded faded fad med waded faded fad red waded laded lad bed waded laded lad fed waded laded lad med waded laded lad red wasps gasps gas ups wasps hasps has ups where there the are where there the ire where there the ore where there the pre where there the ure wirer airer air her wirer airer air mer wirer airer air per wirer airer air ser wirer airer air ter wirer firer fir her wirer firer fir mer wirer firer fir per wirer firer fir ser wirer firer fir ter wryly dryly dry fly wryly dryly dry ply wryly dryly dry sly xenon tenon ten bon xenon tenon ten con xenon tenon ten don xenon tenon ten gon xenon tenon ten hon xenon tenon ten ion xenon tenon ten pon xenon tenon ten son xenon tenon ten von xenon tenon ten won xenon tenon ten yon C:\chas_sandbox>
(this time the output gets readmore tags)
|
|---|