PerlTk - Playing w/ Tk & threads

Author

Playing w/ Tk & threads

Dean Arnold

2004-04-07, 12:31 am

(WinXP, AS 5.8.3, Ptk 804.026+patches)

Out of curiousity, I began toying with threads
under Ptk, and things seem to behave reasonably
well *if* the code is structured the right way (tho
I haven't tried non-WinXP yet).

Basically, using the MVC architecture, make the View the
Parent thread, the Model the child thread(s), and
run the Controller as a after/repeat() coderef in
the parent thread (see code below).

The included app seems to behave nicely.
Structured as described, using a thread-safe
DBI driver to connect to a dbms (via TCP/IP) and do some simple stuff,
along with another repeat() in the parent thread
executing concurrently with the thread,
and only using queues to communicate everything,
things seem well-behaved thus far.

Notes:
1. For the adventurous, you'll need to modify
the DBI->connect params for your database/userid,
and I don't know how many other DBI's are considered thread-safe
yet...Or maybe substitute some TCP code to download
your favorite website ?

2. Queues might be a bit heavyweight, but are pretty
flexible compared to thread shared/locked memory.

3. Note that the Model part of this never directly touches
the View (which, in theory, is how MVC should work).
I can understand why Ptk may never be able to be
*completely* threadsafe (ie, arbitrary threads able to manipulate
any arbitrary widget), unless/until Perl supports some flag to
force *everything* created within a module to be shared; the
chore of trying to expllicitly create everything shared would
probably be overwhelming.

4. Haven't tried anything compute bound in the thread yet,
but thats a problem for Ptk wo/ threads anyway.

5. I already have a (fairly complex) non-threaded
Ptk app that does similar things, except it has to do a
lot of extra fancy stuff to execute the DBI calls in a
non-blocking fashion, so this architecture would be
a godsend...*if* its safe.

All that being said -
Can anyone point out reasons why this might
break ?

Comments/concerns/suggestions welcome,
Dean Arnold
Presicient Corp.
www.presicient.com

### BEGIN CODE ####

use Tk;
use Tk::Text;
use threads;
use threads::shared; # so we can share data
use Thread::Queue; # a thread-safe shared queue!
use DBI;

my $wqueue = Thread::Queue->new();
my $rqueue = Thread::Queue->new();

my $thread = threads->create(\&update_thread, $wqueue, $rqueue);

my $mw = MainWindow->new;

my $topf = $mw->Frame->pack(-side => 'top', -fill => 'both', -expand => 1);
my $textf = $topf->Frame->pack(-side => 'right', -fill => 'both',
-expand => 1);
my $b = $mw->Frame->pack(-side => 'bottom', -fill => 'both', -expand => 0);

my $text = $textf->Text(
-background => 'white',
-wrap => 'none',
-tabs => [ 4 ],
-height => 30,
-selectforeground => 'blue',
-selectbackground => 'green')
->pack(-side => 'top', -anchor => 'n', -fill => 'both', -ipady => 10,
-expand => 1);

$b->Button(-text => 'Update Thread',
-command => \&do_thread_update)->pack(-side => 'left');

my $alldone;
$b->Button(-text => 'Exit',
-command => sub { $alldone = 1; } )->pack(-side => 'left');

$mw->repeat(100, \&do_text_update);
$mw->repeat(1500, sub { $text->insert('end', "woke up\n"); });

MainLoop;

sub do_thread_update {
$wqueue->enqueue('UPDATE');
}

sub do_text_update {
if ($alldone) {
$wqueue->enqueue('DONE');
$thread->join();
exit;
}
while (1) {
my $val = $rqueue->dequeue_nb();
return 1 unless defined($val);
$text->insert('end', "$val\n");
}
}

sub update_thread {
my ($rqueue, $wqueue) = @_;

my $seed = 100;

while (1) {
my $cmd = $rqueue->dequeue();
last if ($cmd eq 'DONE');

my $dbh = DBI->connect('dbi:Teradata:localhost', 'dbitst', 'dbitst',
{RaiseError => 0, PrintError => 0} );
$wqueue->enqueue("ERROR $DBI::errstr"), next
unless $dbh;

my $sth = $dbh->prepare('select user, date, time');
$wqueue->enqueue('ERROR ' . $dbh->errstr), next
unless $sth;

my $rc = $sth->execute;
$wqueue->enqueue('ERROR ' . $sth->errstr), next
unless defined($rc);

my $row;
while ($row = $sth->fetchrow_arrayref) {
foreach (0..$#$row) {
$$row[$_] = 'NULL' unless defined($$row[$_]);
}
$wqueue->enqueue('RESULT ' . join(', ', @$row));
}

$dbh->disconnect;
}
return 1;
}

-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server. If you wish to unsubscribe from this mailing list, send the
message body of "unsubscribe ptk" to majordomo@lists.stanford.edu

Nick Ing-Simmons

2004-04-07, 8:36 am

Dean Arnold <darnold@presicient.com> writes:
>(WinXP, AS 5.8.3, Ptk 804.026+patches)
>
>Out of curiousity, I began toying with threads
>under Ptk, and things seem to behave reasonably
>well *if* the code is structured the right way (tho
>I haven't tried non-WinXP yet).

For the record:

"Use of perl/Tk with threads is not supported".

I am not saying this will not work - as far as I know so long as only
one thread touches the Tk parts all should be well, but I don't
"know" very much in this area. I "know" Tcl/Tk has more threading support
and that I have stubbed thosen functions out as NOPs and to use "static"
data. I "know" perl's memory allocation when threads are used is
awkward for sharing data. I _don't_ know how two threading models
should/will be reconciled.

So feel free to "play" and even feed back complaints/results,
but if it doesn't work there is no commitment on my part to
make it work.

>I can understand why Ptk may never be able to be
>*completely* threadsafe (ie, arbitrary threads able to manipulate
>any arbitrary widget), unless/until Perl supports some flag to
>force *everything* created within a module to be shared;

That probably isn't right either - core Tk wants thread local storage
for some things, and Win32 even seems to require this so that messages
can be sent to thread's queue.

>the
>chore of trying to expllicitly create everything shared would
>probably be overwhelming.

And a performance hog for non-threaded apps.
It is far from clear how perl5's current share-via-tie scheme
maps to non-perl data (like C struct and "name" representing a Widget
vs the perl hash that represents the object.)

>
>4. Haven't tried anything compute bound in the thread yet,
>but thats a problem for Ptk wo/ threads anyway.
>
>5. I already have a (fairly complex) non-threaded
>Ptk app that does similar things, except it has to do a
>lot of extra fancy stuff to execute the DBI calls in a
>non-blocking fashion, so this architecture would be
>a godsend...*if* its safe.
>
>All that being said -
>Can anyone point out reasons why this might
>break ?
>
>Comments/concerns/suggestions welcome,
>Dean Arnold
>Presicient Corp.
>www.presicient.com
>
>### BEGIN CODE ####
>
>use Tk;
>use Tk::Text;
>use threads;
>use threads::shared; # so we can share data
>use Thread::Queue; # a thread-safe shared queue!
>use DBI;
>
>my $wqueue = Thread::Queue->new();
>my $rqueue = Thread::Queue->new();
>
>my $thread = threads->create(\&update_thread, $wqueue, $rqueue);
>
>my $mw = MainWindow->new;
>
>my $topf = $mw->Frame->pack(-side => 'top', -fill => 'both', -expand => 1);
>my $textf = $topf->Frame->pack(-side => 'right', -fill => 'both',
> -expand => 1);
>my $b = $mw->Frame->pack(-side => 'bottom', -fill => 'both', -expand => 0);
>
>my $text = $textf->Text(
> -background => 'white',
> -wrap => 'none',
> -tabs => [ 4 ],
> -height => 30,
> -selectforeground => 'blue',
> -selectbackground => 'green')
>->pack(-side => 'top', -anchor => 'n', -fill => 'both', -ipady => 10,
> -expand => 1);
>
>$b->Button(-text => 'Update Thread',
> -command => \&do_thread_update)->pack(-side => 'left');
>
>my $alldone;
>$b->Button(-text => 'Exit',
> -command => sub { $alldone = 1; } )->pack(-side => 'left');
>
>$mw->repeat(100, \&do_text_update);
>$mw->repeat(1500, sub { $text->insert('end', "woke up\n"); });
>
>MainLoop;
>
>sub do_thread_update {
> $wqueue->enqueue('UPDATE');
>}
>
>sub do_text_update {
> if ($alldone) {
> $wqueue->enqueue('DONE');
> $thread->join();
> exit;
> }
> while (1) {
> my $val = $rqueue->dequeue_nb();
> return 1 unless defined($val);
> $text->insert('end', "$val\n");
> }
>}
>
>sub update_thread {
> my ($rqueue, $wqueue) = @_;
>
> my $seed = 100;
>
> while (1) {
> my $cmd = $rqueue->dequeue();
> last if ($cmd eq 'DONE');
>
> my $dbh = DBI->connect('dbi:Teradata:localhost', 'dbitst', 'dbitst',
> {RaiseError => 0, PrintError => 0} );
> $wqueue->enqueue("ERROR $DBI::errstr"), next
> unless $dbh;
>
> my $sth = $dbh->prepare('select user, date, time');
> $wqueue->enqueue('ERROR ' . $dbh->errstr), next
> unless $sth;
>
> my $rc = $sth->execute;
> $wqueue->enqueue('ERROR ' . $sth->errstr), next
> unless defined($rc);
>
> my $row;
> while ($row = $sth->fetchrow_arrayref) {
> foreach (0..$#$row) {
> $$row[$_] = 'NULL' unless defined($$row[$_]);
> }
> $wqueue->enqueue('RESULT ' . join(', ', @$row));
> }
>
> $dbh->disconnect;
> }
> return 1;
>}
>
>
>-++**==--++**==--++**==--++**==--++**==--++**==--++**==
>This message was posted through the Stanford campus mailing list
>server. If you wish to unsubscribe from this mailing list, send the
>message body of "unsubscribe ptk" to majordomo@lists.stanford.edu

-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server. If you wish to unsubscribe from this mailing list, send the
message body of "unsubscribe ptk" to majordomo@lists.stanford.edu

$_@_.%_

2004-04-07, 10:38 am

Nick Ing-Simmons <nick@ing-simmons.net> wrote in message-id:
<20040407102412.22110.5@llama.ing-simmons.net>
>
>Dean Arnold <darnold@presicient.com> writes:
>
>For the record:
>
>"Use of perl/Tk with threads is not supported".
>
Weak

$_@_.%_

2004-04-07, 10:38 am

"Dean Arnold" <darnold@presicient.com> wrote in message-id:
<c4vsld$fm8$1@fidoii.CC.Lehigh.EDU>
>
>(WinXP, AS 5.8.3, Ptk 804.026+patches)
>
>Out of curiousity, I began toying with threads
>under Ptk, and things seem to behave reasonably
>well *if* the code is structured the right way (tho
>I haven't tried non-WinXP yet).

Awesome, this is really great, without threads pTk apps will never
be more than toys imo. Good luck working this out!

Dean Arnold

2004-04-07, 2:33 pm

Message received load & clear.

(But I'm still planning to play around with it
some more; the available nonblocking I/O methods
are too painful for some things I need to do).

Thanks for the edification,
Dean Arnold
Presicient Corp.
www.presicient.com
-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server. If you wish to unsubscribe from this mailing list, send the
message body of "unsubscribe ptk" to majordomo@lists.stanford.edu

Sponsored Links