Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Re^4: Thread Design help

by Anonymous Monk
on Sep 08, 2010 at 17:44 UTC ( #859373=note: print w/ replies, xml ) Need Help??


in reply to Re^3: Thread Design help
in thread Thread Design help

here is the code for getConn.

sub getConn { my ($DB,$pwd) = @_; my $count = 0; my $dbhParm; my $USER = 'sa'; my $api = 'Sybase'; while(!$dbhParm) { if (! ($dbhParm = DBI->connect("dbi:$api:${DB}", $USER, $pwd, {Pri +ntError => 0}))) { warn "Can't connect to ${DB} as \"$USER\"\n$DBI::errstr... Ret +ry after 1 seconds\n"; sleep (1); $count++; if ($count > 2) { print "Connection to the database, ${DB} could not be esta +blished"; } } last if ($count > 2); # Give up after three tries } return $dbhParm; }


Comment on Re^4: Thread Design help
Download Code
Re^5: Thread Design help
by Corion (Pope) on Sep 08, 2010 at 17:57 UTC

    The following code works for me.

    use strict; use threads; use Data::Dumper; use Thread::Queue; warn "Using threads $threads::VERSION"; warn "Using Thread::Queue $Thread::Queue::VERSION"; my $THREADS = 2; my %dataEntity; while(<>){ chomp; next if !length($_); my ($dsName,$passwd) = split /\|/, $_; $dataEntity{$dsName} = $passwd; } my $request = Thread::Queue->new; my $response = Thread::Queue->new; # Submit all requests for my $dbname (keys %dataEntity) { $request->enqueue([$dbname,$dataEntity{$dbname}]); }; sub getConn {}; # Tell each thread that we're done for (1..$THREADS) { $request->enqueue(undef); }; # Launch our threads for (1..$THREADS) { async(\&getData); }; sub getData { my $idx = 1; while (my $job = $request->dequeue()) { my ($dbname, $credentials) = @$job; #connect to DB, retrieve information my $dbh = getConn($dbname,$credentials); my %results; #my $resArrRef = $dbh->selectall_arrayref("select srvname,dbna +me from syslogins",{ Slice => {} }); # package some dummy results my $resArrRef = [ { srvname => "server:$dbname:".$idx++, dbname => $dbname, +}, { srvname => "server:$dbname:".$idx++, dbname => $dbname, +}, { srvname => "server:$dbname:".$idx++, dbname => $dbname, +}, { srvname => "server:$dbname:".$idx++, dbname => $dbname, +}, ]; foreach my $row ( @$resArrRef ) { $results{$row->{srvname}} = $row->{dbname}; } $response->enqueue(\%results); }; # tell our main thread we're done $response->enqueue( undef ); }; while ($THREADS) { while (my $payload = $response->dequeue()) { print Dumper $payload; }; $THREADS-- };

    Output

    Using threads 1.73 at tmp.pl line 6. Using Thread::Queue 2.11 at tmp.pl line 7. qwe asd yxc zui jjj ^Z $VAR1 = { 'server:asd:4' => 'asd', 'server:asd:2' => 'asd', 'server:asd:1' => 'asd', 'server:asd:3' => 'asd' }; $VAR1 = { 'server:zui:5' => 'zui', 'server:zui:7' => 'zui', 'server:zui:8' => 'zui', 'server:zui:6' => 'zui' }; $VAR1 = { 'server:jjj:9' => 'jjj', 'server:jjj:11' => 'jjj', 'server:jjj:10' => 'jjj', 'server:jjj:12' => 'jjj' }; $VAR1 = { 'server:yxc:14' => 'yxc', 'server:yxc:15' => 'yxc', 'server:yxc:13' => 'yxc', 'server:yxc:16' => 'yxc' }; $VAR1 = { 'server:qwe:18' => 'qwe', 'server:qwe:19' => 'qwe', 'server:qwe:20' => 'qwe', 'server:qwe:17' => 'qwe' }; Perl exited with active threads: 0 running and unjoined 2 finished and unjoined 0 running and detached
      do you think, this is causing problem ?
      do i need to get latest version of modules:
      Using threads 1.05 at ./thread2.pl line 9. Using Thread::Queue 2.00 at ./thread2.pl line 10. Invalid value for shared scalar at /opt/perl-5.8.6_1/lib/5.8.6/Thread/Queue.pm line 90, <> line 10.
      which is the most stable version of perl for thread purpose ?

        Well, I use the following versions:

        Using threads 1.73 at tmp.pl line 6. Using Thread::Queue 2.11 at tmp.pl line 7.

        So maybe just upgrading Thread::Queue or upgrading threads, or upgrading both might help. The posted code works for me, that's all I can say.

        The combination of this line:

        $request->enqueue( [$dbname,$dataEntity{$dbname}] );

        And the very down-level version of threads you are using is almost certainly the source of your problem.

        You might be able to fix it without upgrading by changing the code to be:

        use threads::shared; ... for my $dbname (keys %dataEntity) { my @args :shared = ( $dbname,$dataEntity{$dbname} ); $request->enqueue( \@args ); };

        But I would still suggest upgrading threads, threads::shared and Thread::Queue ASAP.


        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.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://859373]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (9)
As of 2014-07-23 22:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (153 votes), past polls