I want to send message to thread in synchronous mode and get result using trace variable metohd. The problem is that I dont get any response from thread. When I send message in normal mode (thread:: send thread_id {command} var) then I also get the result which is saved in var. Could anyone point out where I make mistake ? Below I pass my code :
trace add variable res write {apply {{v1 v2 op} {
upvar 1 $v1 v
puts "updated variable to $v"}}}
set th [thread::create {
puts "new thread id : [thread::id]"
proc fun {n} {
return [expr {$n*2}]
}
thread::wait
}]
# thread::send $th [list fun $t] res
thread::send -async $th [list fun 43] res
Are you waiting for events in the source/main thread? If you aren't, you'll never process the asynchronous response message that causes the res variable to be set.
Related
I have created a thread :
set t1 [thread::create]
thread::send $t1 {
proc myProc {command args} {
exec {*}[auto_execok $command] {*}$args >& /dev/null
}
}
And then tried to send an asynchronous command :
thread::send -async $t1 [list myProc <command args>]
But the error/output from the command is getting displayed in output.
How to hide the errors/outputs from the command that is send to the async thread ?
The simplest method is to catch the errors.
thread::send $t1 {
proc myProc {command args} {
catch {
exec {*}[auto_execok $command] {*}$args >& /dev/null
}
}
}
Be aware that this makes any problems significantly more difficult to debug! It's better if you can identify what errors you expect and just try to catch them, so unexpected errors are still things you see and have to handle.
thread::send $t1 {
proc myProc {command args} {
try {
exec {*}[auto_execok $command] {*}$args >& /dev/null
} trap CHILDSTATUS {} {
# Ignore a non-zero exit?
}
}
}
For this specific case (which is very much I/O-bound from Tcl's perspective) you might be better off just adding & to the end of the exec call and not running in a separate thread. Can't really say for sure without knowing exactly what you're doing, but it is worth considering.
I am trying to handle spawn process thru thread , but its throwing error "invalid command" .
But without thread its working fine .
set listner [thread::create {
package require Expect
proc router_config {s filename} {
set command_router "{Password: } {abc#123\r}
{Router>} {en\r}
{Password: } {abc#123\r}"
spawn telnet 1.1.1.1
foreach {exp_prompt send_cmd} $command_router {
expect "$exp_prompt"
exp_send "$send_cmd"
}
return 1
}
[thread::wait]
}]
set commandString "xyz"
eval [subst {thread::send -async $listner \
{router_config 0 [list $commandString ]}}]
puts "--------->> releasing thread [thread::id] [thread::release]"
exit 0
Please suggest some way to handle .
My Perl script needs to run multiple threads simultaneously...
use threads ('yield', 'exit' => 'threads_only');
use threads::shared;
use strict;
use warnings;
no warnings 'threads';
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Async;
use ...
...and such threads need to obtain some information from web, so HTTP::Async is used.
my $request = HTTP::Request->new;
$request->protocol('HTTP/1.1');
$request->method('GET');
$request->header('User-Agent' => '...');
my $async = HTTP::Async->new( slots => 100,
timeout => REQUEST_TIMEOUT,
max_request_time => REQUEST_TIMEOUT );
But some threads need to access web only when other thread(s) says so.
my $start = [Time::HiRes::gettimeofday()];
my #threads = ();
foreach ... {
$thread = threads->create(
sub {
local $SIG{KILL} = sub { threads->exit };
my $url = shift;
if ($url ... ) {
# wait for "go" signal from other threads
}
my ($response, $data);
$request->url($url);
$data = '';
$async->add($request);
while ($response = $async->wait_for_next_response) {
threads->yield();
$data .= $response->as_string;
}
if ($data ... ) {
# send "go" signal to waiting threads
}
}
}, $_);
if (defined $thread) {
$thread->detach;
push (#threads, $thread);
}
}
There might be one or more threads waiting for "go" signal and there might be one or more threads that such "go" signal can send. At the beginning the status of semaphore is "wait" and once it turns to "go", it will stay so.
Finally, app checks max running time. If threads are running too long, self-termination signal is sent.
my $running;
do {
$running = 0;
foreach my $thread (#threads) {
$running++ if $thread->is_running();
}
threads->yield();
} until (($running == 0) ||
(Time::HiRes::tv_interval($start) > MAX_RUN_TIME));
$running = 0;
foreach my $thread (#threads) {
if ($thread->is_running()) {
$thread->kill('KILL');
$running++;
}
}
threads->yield();
Now to the point. My questions are:
How can I most effectively code waiting "semaphore" in the script (see comments in script above). Should I simply use just shared variable with some dummy sleep loop?
Do I need to add some sleep loop at the end of app to give time to threads for self-destruction?
You might look at Thread::Queue to perform this work. You could setup a queue that would handle the signaling between the threads waiting for the 'go' signal and the threads sending the 'go' signal. Here's a quick mock-up that I haven't tested:
...
use Thread::Queue;
...
# In main body
my $q = Thread::Queue->new();
...
$thread = threads->create(
sub {
local $SIG{KILL} = sub { threads->exit };
my $url = shift;
if ($url ... ) {
# wait for "go" signal from other threads
my $mesg = $q->dequeue();
# you could put in some termination code if the $mesg isn't 'go'
if ($mesg ne 'go') { ... }
}
...
if ($data ... ) {
# send "go" signal to waiting threads
$q->enqueue('go');
}
}
}, $_);
...
The threads that need to wait for a 'go' signal will wait on the dequeue method until something enters the queue. Once a message enters the queue one thread and only one thread will grab the message and process it.
If you wish to stop the threads so that they won't run, you can insert a stop message to the head of the queue.
$q->insert(0, 'stop') foreach (#threads);
There are examples in Thread::Queue and threads CPAN distributions that show this in more detail.
In response to your second question, the answer is, unfortunately, it depends. When you proceed to terminate your threads, what kind of clean up is required for a clean shutdown? What's the worst case scenario that could occur if the rug was yanked out from beneath the thread? You would want to plan in any time for the clean up to occur. The other option you could do is wait on each thread to actually complete.
The reason for my comment asking if you could remove the detach call is because this method allows the main thread to exit and not care what was happening to any child threads. Instead, if you remove this call, and add:
$_->join() foreach threads->list();
to the end of your main block, this will require the main application to wait for each thread to actually complete.
If you leave the detach method in place, then you will need to sleep at the end of your code if you require your threads to perform any sort of clean-up. When you call detach on a thread, what you are telling Perl is that you don't care what the thread is doing when your main thread exits. If the main thread exits and there are threads that still running that have been detached, then the program will finish with no warnings. However, if you don't require any clean-up, and you still call detach, feel free to exit whenever you like.
Try out something like this....
#!/usr/bin/perl
use threads;
use threads::shared;
$|=1;
my ($global):shared;
my (#threads);
push(#threads, threads->new(\&mySub,1));
push(#threads, threads->new(\&mySub,2));
push(#threads, threads->new(\&mySub,3));
$i = 0;
foreach my $myThread(#threads)
{
my #ReturnData = $myTread->join ;
print "Thread $i returned: #ReturnData\n";
$i++;
}
sub mySub
{
my ($threadID) = #_;
for(0..1000)
{
$global++;
print "Thread ID: $threadID >> $_ >> GLB: $global\n";
sleep(1);
}
return( $id );
}
I need a logging library for my multi-threaded Tcl aplication. Can I use standard logger package? If I can, what restrictions are applied in multi-threading environment?
I'd like to share logging services among the threads, if possible.
Thanks
Tcl threads do not share data (unless you explicitly use certain facilities from the Thread package) and instead are communicating via message passing. So it seems like the way to go would be to setup a dedicated "logger" thread and just queue logging messages into it from the worker threads.
Otherwise the point of contention will probably be somewhere in the OS resource used by the logger to actually write data.
Update Okay, here's a working sketch of what I actually proposed to implement:
package require Tcl 8.5
package require Thread
proc make_worker_thread {logger_id body} {
set newbody [list set ::logger $logger_id]
append newbody \n {
proc ::log {severity msg} {
global logger
thread::send $logger [list ::log $severity $msg]
}
} \n $body
thread::create $newbody
}
set logger [thread::create {
package require logger
proc log {severity msg} {
puts "hey, that's it: ($severity) $msg"
}
puts "logger thread created: [thread::id]"
thread::wait
}]
for {set i 0} {$i < 3} {incr i} {
make_worker_thread $logger {
proc post_msg {} {
log notice "A message from [thread::id]"
after 1000 ::post_msg
}
puts "worker thread created: [thread::id]"
after 1000 ::post_msg
thread::wait
}
}
vwait forever
This code creates one logger thread and four worker threads each of which posts a message to the logger thread once per second. The code runs until manually interrupted. The logger thread just simple-mindedly outputs the message it was passed to the console, but as someone else in this thread already mentioned, you could probably use the "logger" package from Tcllib, if you need fancy stuff like facilities.
To reiterate my points:
The logger package itself does not presumably know anything about threading.
Tcl threads are well-separated and usually communicate via message passing.
Hence create a thread for the logger and teach worker threads send messages to it; therefore working threads are not concerned with how logger is implemented.
P.S. In the worker threads, you can use [thread::send -async ...] to make sending log messages fully asynchronous.
A Logging API for Tcl
This implementation is thread safe. Because of the general
purpose the C-functions do not require a tcl-interpreter.
It depends a bit on what you want to achieve with a multithreaded use of logger.
If you just have the use case to not block your worker threads while writing log messages to disk, the simplest way is to use logger normally and configure a simple logproc that does a thread::send -async to some logging thread (which might itself use logger with appenders to write the actual log files) with your log message (basically what has been sketched in the accepted answer).
If you want to use loggers option to disable/enable logging for the whole program, across various threads, you need to do a little more work to propagate loglevel changes to all threads via custom lvlchangeproc's.
Here is my "multithreading" wrapper for logger package:
# replacement for logger::init procedure from logger package
proc ::mylogger::init { service } {
set log [logger::init $service]
foreach lvl [logger::levels] {
interp alias {} log_to_file_$lvl {} ::mylogger::log $lvl $service
${log}::logproc $lvl log_to_file_$lvl
}
return $log
}
proc mylogger::server { } {
set t [thread::create {
proc log { level txt } {
set msg "\[[clock format [clock seconds] -format "%Y-%m-%dT%H:%M:%S"]\]\t$level\t$txt"
puts stderr $msg
}
# enter to event loop
thread::wait
}]
tsv::set measure-logger loggerThread $t
}
proc ::mylogger::log { level service txt } {
set t [tsv::get measure-logger loggerThread]
thread::send -async $t [list log $level "$service\t$txt"]
}
# EXAMPLE
# start logging thread
# should be called once from main application thread
::mylogger::server
# create logger
# may be called from any thread
set log [mylogger::init myservice]
# log a message
# may be called from the thread the "mylogger::init myservice" was called in
${log}::debug myservice "Hello, World!"
# wait a second
after 1000
I am trying to run a thread continuously and not have it become blocked by the tcl main event loop.
Here is a simple example of what I'm trying to do:
#!/bin/sh
#\
exec tclsh "$0" "$#"
package require Thread
set ::a_thread [thread::create {thread::wait}]
proc start_a {} {
thread::send $::a_thread {
puts "Running a thread"
}
after 1000 a_start
}
proc infinite_loop {} {
while {1} {
puts "Loop"
after 500
}
}
start_a
infinite_loop
vwait forever
In this code, the infinite_loop proc is called and the main event loop runs infinitely. I would like it if the a_thread could still run in the background though. How can I achieve this?
The main event loop is not blocking your thread. Instead you are using the main event loop to shedule scripts to be executed in the thread. Instead, run the scheduler in the thread itself:
Code tested and works as expected:
thread::send $::a_thread {
proc loop {} {
puts "running a thread"
after 1000 loop
}
loop
}
while 1 {
puts "loop"
after 500
}
The answer is, of course, the one given by slebetman. However, one way to debug this sort of thing (especially in more complex cases) is to prefix the messages printed by each thread by the result of thread::id, and to make sure you print a message at the start of each time round the loop. For example:
package require Thread
set ::a_thread [thread::create {thread::wait}]
proc start_a {} {
puts "[thread::id]: Dispatch to $::a_thread"
thread::send $::a_thread {
puts "[thread::id]: Running a thread"
}
after 1000 a_start
}
proc infinite_loop {} {
while {1} {
puts "[thread::id]: Loop"
after 500
}
}
start_a
infinite_loop
puts "[thread::id]: Start main event loop"
vwait forever
That would have told you that the dispatch was happening once, that the running in the other thread is happening synchronously (thread::send waits for the script to finish executing by default), and that the infinite loop is preventing the startup of the main event loop (and hence the rescheduling of the dispatch). Since you didn't know who was doing what, of course there was confusion!