Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

multi-threaded win32::console

by Anonymous Monk
on Aug 13, 2007 at 21:30 UTC ( [id://632320]=perlquestion: print w/replies, xml ) Need Help??

Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

I humbly seek wisdom.

I have a multi-threaded program using Thread::Queue to pass reults to the next thread. Main drops $href = &share({}); onto the first (zeroth?) queue. Each thread takes off the previous queue, produces as many $outSolutionref = &share({}); as necessary and puts them on the next queue.

So far, so good. In fact so good I could stop (but what would be the fun in that?).

Now I'm thinking of writing status out while it's working instead of only when it's done, so I'm using Win32::Console to write out the count of results taken off the input queue and written to the output queue for each thread:

#/usr/bin/perl -w use strict; use threads; use threads::shared; use Thread::Queue; use Win32::Console; my $CONSOLE = Win32::Console->new(STD_OUTPUT_HANDLE); my $CURRENT_ROW = 3; my @consoleInfo = $CONSOLE->Info(); my $statusRow = $consoleInfo[$CURRENT_ROW]; my $numthreads = 4; my @DataQueues; #There are n+1 queues (mileposts vs. miles). for ($i = 0; $i <= $numthreads + 1; $i++) { $DataQueues[$i] = Thread::Queue->new; } my @aThreads; for ($i=0; $i <= $numthreads; $i++) { $aThreads[$i] = threads->new(\&threadprocessor, $DataQueues[$i], $D +ataQueues[$i+1], $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; } #dequeue from the last queue of the chain my $Solutionref; my %Solution; print "\nresults: \n"; while ($Solutionref = $DataQueues[$#DataQueues]->dequeue) { %Solution = %{$Solutionref}; printSolution (\%Solution); } print "\n"; sub printSolution { my $href = shift; print "\nKEYS: "; print(($_).' ') foreach (sort keys %{$href}); print "\nvals: "; print(($$href{$_}).' ') foreach (sort keys %{$href}); print "\n"; } sub threadprocessor { my ($inqueue, $outqueue, $threadNum) = @_; my $inSolnQty = 0; my $outSolnQty = 0; my $statString; my $threadStatusColumn = $threadNum * 12; my $inSolutionref; my %inSolution; my $outSolutionref; my %outSolution; while ($inSolutionref = $inqueue->dequeue) { $statString = sprintf ("%5s/%-5s", $inPattQty++, $outPattQty); $CONSOLE->WriteChar($statString, $threadStatusColumn, $statusR +ow); %inSolution = %{$inSolutionref}; While (<>) #ok, I'm hiding complexity here if (isSolution($_)) { #ok, I'm hiding complexity here $outSolutionref = &share({}); %$outSolutionref = (%inSolution); #ok, I'm hiding complexity here $outqueue->enqueue($outSolutionref); $statString = sprintf ("%5s/%-5s", $inSolnQty, $outSol +nQty++); $threadCONSOLE->WriteChar($statString, $threadStatusCo +lumn, $statusRow); } } } $outqueue->enqueue(undef); $statString = sprintf ("%5s/%-5s.", $inSolnQty, $outSolnQty); $threadCONSOLE->WriteChar($statString, $threadStatusColumn, $statu +sRow) }

The problem being, after the first queue ends (as indicated by the period) all output stops. Do I need to share the $CONSOLE? or something? What documentation should I have read?

Replies are listed 'Best First'.
Re: multi-threaded win32::console
by BrowserUk (Patriarch) on Aug 13, 2007 at 21:46 UTC

    Um, you obtain $CONSOLE at the top of your code and "share" it via closure(*) with the thread routine.

    And in your thread routine you use $CONSOLE...once. Then, for no apparent reason, you switch to using $threadCONSOLE which is never declared or initialised.

    And despite your post showing use strict; at the top, when I try syntax checking it, I get:

    C:\test>perl -c 632320.pl Global symbol "$i" requires explicit package name at 632320.pl line 17 +. Global symbol "$i" requires explicit package name at 632320.pl line 17 +. Global symbol "$i" requires explicit package name at 632320.pl line 17 +. Global symbol "$i" requires explicit package name at 632320.pl line 18 +. Global symbol "$i" requires explicit package name at 632320.pl line 22 +. Global symbol "$i" requires explicit package name at 632320.pl line 22 +. Global symbol "$i" requires explicit package name at 632320.pl line 22 +. Global symbol "$i" requires explicit package name at 632320.pl line 23 +. Global symbol "$i" requires explicit package name at 632320.pl line 24 +. Global symbol "$i" requires explicit package name at 632320.pl line 24 +. Global symbol "$i" requires explicit package name at 632320.pl line 25 +. Global symbol "$i" requires explicit package name at 632320.pl line 34 +. Global symbol "$i" requires explicit package name at 632320.pl line 34 +. Global symbol "$i" requires explicit package name at 632320.pl line 34 +. Global symbol "$i" requires explicit package name at 632320.pl line 35 +. Global symbol "$inPattQty" requires explicit package name at 632320.pl + line 69. Global symbol "$outPattQty" requires explicit package name at 632320.p +l line 69. syntax error at 632320.pl line 73, near ") {" 632320.pl has too many errors.

    Update: hacking my way past all the errors and warnings, your code seems to run:

    #/usr/bin/perl -w use strict; use threads; use threads::shared; use Thread::Queue; use Win32::Console; my $CONSOLE = Win32::Console->new(STD_OUTPUT_HANDLE); my $CURRENT_ROW = 3; my @consoleInfo = $CONSOLE->Info(); my $statusRow = $consoleInfo[$CURRENT_ROW]; my $numthreads = 4; my @DataQueues; #There are n+1 queues (mileposts vs. miles). for (my $i = 0; $i <= $numthreads + 1; $i++) { $DataQueues[$i] = Thread::Queue->new; } my @aThreads; for (my $i=0; $i <= $numthreads; $i++) { $aThreads[$i] = threads->new( \&threadprocessor, $DataQueues[$i], $DataQueues[$i+1], $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 (my $i=0; $i<=$#aThreads; $i++) { $aThreads[$i]->join; } #dequeue from the last queue of the chain my $Solutionref; my %Solution; print "\nresults: \n"; while ($Solutionref = $DataQueues[$#DataQueues]->dequeue) { %Solution = %{$Solutionref}; printSolution (\%Solution); } print "\n"; sub printSolution { my $href = shift; print "\nKEYS: "; print(($_).' ') foreach (sort keys %{$href}); print "\nvals: "; print(($$href{$_}).' ') foreach (sort keys %{$href}); print "\n"; } sub isSolution{ 1 } sub threadprocessor { my ($inqueue, $outqueue, $threadNum) = @_; my $inSolnQty = 0; my $outSolnQty = 0; my $statString; my $threadStatusColumn = $threadNum * 12; my $inSolutionref; my %inSolution; my $outSolutionref; my %outSolution; while ($inSolutionref = $inqueue->dequeue) { $statString = sprintf ("%5s/%-5s", $inSolnQty++, $outSolnQty ) +; $CONSOLE->WriteChar($statString, $threadStatusColumn, $statusR +ow); %inSolution = %{$inSolutionref}; while (<>) { #ok, I'm hiding complexity here if (isSolution($_)) { #ok, I'm hiding complexity here $outSolutionref = &share({}); %$outSolutionref = (%inSolution); #ok, I'm hiding complexity here $outqueue->enqueue($outSolutionref); $statString = sprintf ("%5s/%-5s", $inSolnQty, $outSol +nQty++); $CONSOLE->WriteChar($statString, $threadStatusColumn, +$statusRow); } } } $outqueue->enqueue(undef); $statString = sprintf ("%5s/%-5s.", $inSolnQty, $outSolnQty); $CONSOLE->WriteChar($statString, $threadStatusColumn, $statusRow) }

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

      First variant of my full code. my $CONSOLE is in main and my $threadCONSOLE is in the thread.

      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:

      C:\chas_sandbox>test.pl 1/177 . 3/8 4/4 3/16 C:\chas_sandbox>

      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.

        When I run the above, I get reams and reams of

        Use of uninitialized value in exists at C:\test\632320.pl line 161. Use of uninitialized value in null operation at C:\test\632320.pl line + 161. Use of uninitialized value in hash element at C:\test\632320.pl line 1 +67. Use of uninitialized value in hash element at C:\test\632320.pl line 1 +67. Use of uninitialized value in hash element at C:\test\632320.pl line 1 +67. Use of uninitialized value in hash element at C:\test\632320.pl line 1 +67. Use of uninitialized value in exists at C:\test\632320.pl line 161. ...

        It's not at all clear to me what a 'null operation' is, (I don't think I ever encountered that one before :), but the main problem appears to be that your code is still displaying signs of its no strict; heritage.

        Specifically, within your compare sub, you have the loop iterator declared ahead of the first loop:

        my $k; foreach $k ( keys %{ $hrefA } ) {

        which is rarely better than declaring it in line, but is sometimes necessary if you wish to retain its value beyond the end of the loop.

        However, in the next loop, which is only entered if you found whatever you are looking for in the first, you have no loop iterator variable, but do not appear to use $_ anywhere within it?

        And the first thing you do within that second loop is test if the value of $k exists as a key within $hrefA.

        if ($result) { foreach (keys(%{$hrefB})) { ## No loop variable if ( exists $hrefA->{$k} ) { ## line 161

        But, as the value of $k is being retained from the first loop where it is explicitly looping over the keys of $hrefA (as shown above), then that test would appear to be redundant.

        Except, the undefined warning for line 161 relates to the fact that somehow you are reaching this line with $k undefined.

        My best guess, without having tried to work my way through and understand everything you are doing, is that your second loop is meant to be iterating the keys of $hrefB and checking whether they exist in $hrefA, and that if you replaced those two snippets with;

        ## my $k; foreach my $k ( keys %{ $hrefA } ) { ... if ($result) { foreach my $k (keys(%{$hrefB})) { ## No loop variable if ( exists $hrefA->{$k} ) { ## line 161

        That might eliminate a large number of the warnings, and might also get you closer to making your code do what you are expecting.

        Until you eliminate all the warnings your code is producing, it is impossible (or at least, asking a lot) for us to see symptoms of the problem you describe and so attempt to help you solve that problem.

        I don't insist on use strict; use warnings; although I always use them myself, but in this case, it is very obvious that your code is not doing what you think it is doing, and if you had them enabled, you would have realised it yourself.


        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.

        Second variant of my full code. I've gotten rid of all my $threadCONSOLE refernces and am just using my $CONSOLE from main.

        I get the same results (give or take the non-determinacy in mutliple threads running slightly differently each time).

        C:\chas_sandbox>test.pl 1/177 . 3/8 4/4 4/20 C:\chas_sandbox>

      Very sorry. I wondered a bit at how detailed to paste code and decided to err on the side of brevity. I did not post actual full code, but tried to boil it down to just what was troubling me from a much larger program. I did not try to re-run it after hacking. In the future I'll try to err on the side of completeness.

      On the up side, in the interest of more complete communications, I created a user! I'm trying to read about the scratchpad, etc and figure out how things work around here. I humbly seek patience in the mean time.

      I'll post complete code separately and redescribe the problem.

Re: multi-threaded win32::console
by goibhniu (Hermit) on Aug 15, 2007 at 00:55 UTC

    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.

    Update: Addedlink to needed wordlist. It was referenced earlier in the discussion thread, but I thought it would be good here, closer to the "good" code.


    I humbly seek wisdom.

      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?

      Update: 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.


      I humbly seek wisdom.
Re: multi-threaded win32::console
by Anonymous Monk on Jun 17, 2013 at 06:17 UTC
    This code in Win32::Console caused output stop:
    #============ sub DESTROY { #============ my($self) = @_; _CloseHandle($self->{'handle'}); }
    just comment out _CloseHandle...

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://632320]
Approved by GrandFather
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (4)
As of 2024-03-28 22:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found