I got problem with scalars in my program.
I got code like this:
use threads;
use threads::shared;
use Tk;
$mw = new MainWindow;
my $label = undef;
share($label) my $ok = undef;
share($ok)
HERE IS BUTTON WITH OPTION -command => \&sub1
threads->create('sub2');
sub sub1 {
$top = $mw->TopLevel();
$label = $top->Label( -text => 'something' )->pack();
$ok = 1;
}
sub sub2 {
while (1) {
if ($ok) {
$label->configure( -text => 'i need this' );
$label->update;
}
}
}
I got error in $label->configure(-text => 'i need this'); like this :
Invalid value for shared scalar at xxx.pl
I need to update my label text only from threads and i can't do this.
Thanks for advices.
That error suggests that Tk Label objects simply weren't written to support being shared under ithreads, a circumstance which I'd guess is very arduous to remedy.
I'd suggest instead you make a thread responsible for updating the UI widgets and have that thread receive update instructions from other threads. Awkward, but workable.
Related
I'm fairly new to Perl and am working on a project to further my learning. It's a little console word game (translated from a python project of mine), and part of the logic requires to draw a random letter from a pool that is 98 characters long.
Running the functions individually, I've never had an issue, but when I try to loop it into a list it occasionally fails. Running with warnings on tells me that some of these are undefined, but I can't for the life of me figure out why. Here's an MRE:
package Random;
sub choice {
shift;
my ($str) = #_;
my $random_index = int(rand(length($str)));
return substr($str,$random_index,1); #fixed variable name
}
package Player;
sub new {
my $class = shift;
my $self = { "name" => shift, "letters" => {fillList()} };
bless $self, $class;
return $self;
}
sub drawCharacter {
my $freq = "aaaaaaaaabbccddddeeeeeeeeeeeeffggghhiiiiiiiiijkllllmmnnnnnnooooooooppqrrrrrrssssttttttuuuuvvwwxyyz";
my $choice = Random -> choice($freq);
return $choice;
}
sub fillList {
my #ls = ();
for (0..6) {
push #ls, drawCharacter();
}
return #ls;
}
sub getLetters {
my ($self) = #_;
my $arr = $self -> {letters};
return %$arr;
}
package Main;
my #players = ();
for (0..12){
my $player = Player -> new("Foo");
print($player->getLetters(),"\n");
}
BIG EDIT: Adding the object I'm using. This is verifiably not working. Warnings:
"Use of uninitialized value in print" and "Odd number of elements in anonymous hash". This is where I think the issue lies.
The list returned by fillList sometimes is missing an item or 2, and in some circumstances even 3 or 4 items are missing. Does anybody know what's going on here? The python one hasn't failed once.
If the python analogue would be helpful, I can include that here too.
The error comes from using a hash ref where you should have an array ref:
my $self = { "name" => shift, "letters" => {fillList()} };
# ^ ^-- wrong brackets
This is what the warning talks about:
Odd number of elements in anonymous hash at foo.pl line 22.
You want to change that to:
my $self = { "name" => shift, "letters" => [fillList()] };
# ^ ^--- creates array ref
And also the line which uses this array
return %$arr;
Where you need to change % to #.
return #$arr;
After those fixes, the code runs without errors for me.
I'm trying to make a web server whose requests are farmed out to a set of interpreters hidden behind open2(), based on which 'device' is indicated in the cgi parameters.
The trouble is, I want it multi-threaded but the hash I'm using to try to keep track of the event queue relating to each device doesn't remember the new device created for each request: the server below only prints this sort of thing:
Did not find default-device in (alreadyThere)...
Added default-device with Sun Oct 27 20:43:35 2013 to alreadyThere, default-device
Now... does (alreadyThere, default-device) persist for the next request?
Here is the script:
#!/usr/bin/perl -w
use strict;
use threads;
use threads::shared;
use base qw(Net::Server::HTTP);
our $monkeys = shared_clone({ alreadyThere => { 'a' => 'b' } });
sub process_http_request {
require CGI;
my $cgi = CGI->new;
my $device = $cgi->param('device') || 'default-device';
print "HTTP/1.0 200 OK\r\nContent-type: text/html\r\n\r\n<pre>";
unless (exists $monkeys->{$device}) {
print "Did not find $device in (".join(", ", sort keys %$monkeys).")...\n";
lock $monkeys;
unless (exists $monkeys->{$device}) {
my $t = localtime;
$monkeys->{$device} = $t;
print "\nAdded $device with ".$t." to ".join(", ", sort keys %$monkeys);
} else {
print "\nSurprise device... ".$device;
}
} else {
print "\nFound device... ".$device;
}
print "\nNow... does (".join(", ", sort keys %$monkeys).") persist for the next request?</pre>";
}
__PACKAGE__->run(port => 8080);
It's not the $t bit - that was previously shared_clone({ id => $t }), but I'm darned if I can see why $monkeys never seems to update.
The different requests are served by different processes, not threads.
Net::Server doesn't have a multi-threaded "personality"[1], so you're going to have to use a different sharing mechanism.
Notes:
"in the near future, we would like to add a 'Thread' personality"
Building on Ikegami's answer, I'm trying with this additional code to fake a 'threaded' personality with some success (and some problems with 'open3' misbehaving):
sub default_server_type { 'Single' }
sub loop {
my $self = shift;
while( $self->accept ){
async {
$self->run_client_connection;
};
last if $self->done;
}
}
a) Is there any reason to use Net::Server::HTTP instead of the higher level and easier to use Plack?
b) I've had to solve a problem not unlike this one recently, and settled on using event-based httpd with AnyEvent (or higher abstraction, Coro). There's Net::Server::Coro if you need a drop-in replacement for your code, or even a plethora of canned AnyEvent-based httpds like Twiggy, Feersum, etc.
I get the following error when trying to run my test code:
thread failed to start: Invalid value for shared scalar at ./threaded_test.pl line 47.
Line 47 is:
%hoh = hoh(#new_array);
My observations:
If I remove line 47 and other lines referencing %hoh, then the script runs without errors
I can create a new hash %new_hash = (itchy => "Scratchy"); without errors, but when I try to "return" a hash from another sub (line 47), it results in the error above.
Unfortunately, I cannot use a in/out Queue because the version of Thread::Queue that I use is too old (and installed on a system I have no control over) and doesn't support hash and hash-ref types to be returned via a Queue (according to this). Apparently, my version only support strings to be returned via queues.
Is there a way to successfully do this: $hash{$string}{"jc"} = \%hoh;
#!/usr/bin/perl
use strict;
use warnings;
use threads;
use Thread::Queue;
use constant NUM_WORKERS => 10;
my #out_array : shared = ();
main();
sub main
{
my #results = test1();
foreach my $item (#results) {
print "item: $item\n";
}
}
sub test1
{
my $my_queue = Thread::Queue->new();
foreach (1..NUM_WORKERS) {
async {
while (my $job = $my_queue->dequeue()) {
test2($job);
}
};
}
my #sentiments = ("Axe Murderer", "Mauler", "Babyface", "Dragon");
$my_queue->enqueue(#sentiments);
$my_queue->enqueue(undef) for 1..NUM_WORKERS;
$_->join() for threads->list();
my #return_array = #out_array;
return #return_array;
}
sub test2
{
my $string = $_[0];
my %hash : shared;
my #new_array : shared;
my %new_hash : shared;
my %hoh : shared;
#new_array = ("tom", "jerry");
%new_hash = (itchy => "Scratchy");
%hoh = hoh(#new_array);
my %anon : shared;
$hash{$string} = \%anon;
$hash{$string}{"Grenade"} = \#new_array;
$hash{$string}{"Pipe bomb"} = \%new_hash;
$hash{$string}{"jc"} = \%hoh;
push #out_array, \%hash;
return;
}
sub hoh
{
my %hoh;
foreach my $item (#_) {
$hoh{"jeepers"}{"creepers"} = $item;
}
return %hoh;
}
The problem is that your trying to store a reference to something that isn't shared in a shared variable. You need to use share as previously mentioned, or you need to serialise the data structure.
#!/perl/bin/perl
use strict;
use threads;
use threads::shared;
my %hm_n2g:shared = ();
my $row = &share([]);
$hm_n2g{"aa"}=$row;
$row->[0]=1;
$row->[1]=2;
my #arr = #{$hm_n2g{"aa"}};
print #arr[0]." ".#arr[1]."\n";
#If you want to lock the hash in a thread-subroutine
{
lock(%hm_n2g)
}
Having problems with threads. Keep getting error when creating a thread using a class instance method as the subroutine. The method and params variables are set based on other stuff, so I have to call the class instance method this way. Without the threads, it works just fine. Can't figure out the correct way to specify it for threads create:
my $instance = someclass->new();
my $method = 'get';
my $params = { 'abc' => 123 };
my $thread = threads->create($instance->$method,$params);
This gives me the error "Not a CODE reference". I think this may be actually calling the method, and using the return as the argument. Okay, tried this:
my $thread = threads->create(\&{$instance->$method},$params);
This gives me the error "Not a subroutine reference". I would appreciate any help on this.
my $thread = threads->create(sub { $instance->$method(#_) }, $params);
Or, you could just pass the instance and the method to the first argument as well:
package SomeClass;
sub new {
my $class = shift;
bless { args => [ #_ ] };
}
sub get {
my $self = shift;
my $args = shift;
return join(" ", #{ $self->{args} }, $args->{abc});
}
package main;
use 5.012;
use threads;
my $x = SomeClass->new("An instance");
threads->create(sub { say $x->get(#_) }, {'abc' => 123 })->join;
threads->create(
sub {
my $instance = shift;
my $method = shift;
say $instance->$method(#_);
}, $x, 'get', { 'abc' => 123 }
)->join;
In fact, I would prefer the latter, to avoid closing on $instance.
Calling a method without parens is the same thing as calling the method without arguments:
$foo->bar eq $foo->bar()
To create a coderef, you can either specify a lambda that wraps the method call, e.g.
threads->create(sub{ $instance->get($params) })
(see Sinan Ünürs answer), or you can use the universal can function.
The can method resolves a method in the same way a method would be resolved if it were called, and returns the coderef for that method if it was found, or returns undef. This makes it usable as a boolean test.
Do note that methods are just subroutines with the first argument being the invocant (the object):
my $code = $instance->can($method) or die "Can't resolve $method";
threads->create($code, $instance, $params);
However, can may fail for poorly written classes that make use of AUTOLOAD.
I have a class which isa Qt::Object and has a method that creates a thread.
Whenever I attempt to detach or join the thread it seg faults.
Also the emit signal is not working.
Sample code is:
package MyThread;
use threads;
use Qt;
use Qt::isa qw(Qt::Object);
use Qt::signals
imageResRecieved => ['int', 'int'];
sub NEW
{
shift->SUPER::NEW(#_[0..2]);
if ( name() eq "unnamed" ) {
setName("MyThread" );
}
}
sub getWidthHeight{
my ($seq, $frameNum) = #_;
my ($width, $height) = (1920, 1080);
sleep(2);
print "Emitting\n";
emit imageResRecieved($width, $height);
print "AFTER Emit\n";
}
sub getImageWidthThread{
my $thr = threads->create('getWidthHeight', #_);
$thr->detach(); # This causes seg faults
}
use MyThread;
use Qt::slots
handleImageResSignal => ['int', 'int'];
my $mythread = MyThread();
Qt::Object::connect($irt, SIGNAL "imageResRecieved(int, int)", this, SLOT "handleImageResSignal(int, int)");
$mythread->getImageWidthThread("$GLOBAL{DIR}/$GLOBAL{PAT}", $seq_start);
sub handleImageResSignal{
my ($width, $height) = #_;
print "\n Emitted ${width} ${height} \n";
}
The errors I get are like:
Attempt to free non-existent shared string '39631808', Perl interpreter: 0x2879910.
[1] Segmentation fault
Try involving QThread ... too bad the distribution doesn't come with example, you should request one, in the meantime, try adapting http://www.pyside.org/docs/pyside/PySide/QtCore/QThread.html