multithreading - Is there a thread-safe way to print in Perl? -

i have script kicks off threads perform various actions on several directories. snippet of script is:

#main sub buildinit {      $actionstr = "";     $compstr   = "";      @component_dirs;     @comptobebuilt;     foreach $comp (@complist) {         @component_dirs = getdirs($comp);    #populates @component_dirs     }      print "printing action list: @actionlist\n";      #---------------------------------------     #----   setup worker threads  ----------     ( 1 .. num_workers ) {         async {             while ( defined( $job = $q->dequeue() ) ) {                 worker($job);             }         };     }      #-----------------------------------     #----   enqueue work  ----------     $action (@actionlist) {         $sem = thread::semaphore->new(0);         $q->enqueue( [ $_, $action, $sem ] ) @component_dirs;          $sem->down( scalar @component_dirs );         print "\n------>> waiting prior actions finish up... <<------\n";     }      # nothing more - notify queue we're not adding else     $q->end();     $_->join() threads->list();      return 0; }  #worker sub worker {     ($job) = @_;     ( $component, $action, $sem ) = @$job;     build( $component, $action );     $sem->up(); }  #builder method sub build {      ( $comp, $action ) = @_;     $cmd     = "$make $make_invocation_path/$comp ";     $retcode = -1;      given ($action) {         when ("depend") { $cmd .= "$action >nul 2>&1" }    #suppress output         when ("clean")  { $cmd .= $action }         when ("build")  { $cmd .= 'l1' }         when ("link")   { $cmd .= '' }                     #add nothing; default link         default { die "action: $action unknown me." }     }      print "\n\t\t*** performing action: \'$cmd\' on $comp ***" if $verbose;      if ( $action eq "link" ) {          # hack around potential race conditions -- issue during linking         $tries = 1;         until ( $retcode == 0 or $tries == 0 ) {             last if ( $retcode = system($cmd) ) == 2;      #compile error; stop trying             $tries--;         }     }     else {         $retcode = system($cmd);     }     push( @retcodes, ( $retcode >> 8 ) );      #testing     if ( $retcode != 0 ) {         print "\n\t\t*** error in $comp: $@ !! ***\n";         print "\t\t*** action: $cmd -->> error level: " . ( $retcode >> 8 ) . "\n";          #exit(-1);     }      return $retcode; } 

the print statement i'd thread-safe is: print "\n\t\t*** performing action: \'$cmd\' on $comp ***" if $verbose; ideally, have output, , each component having $action performed on it, output in related chunks. however, doesn't work right - output interleaved part, each thread spitting out it's own information.

e.g.,:

componentafile1.cpp componentafile2.cpp componentafile3.cpp componentbfile1.cpp componentcfile1.cpp componentbfile2.cpp componentcfile2.cpp componentcfile3.cpp ... etc. 

i considered executing system commands using backticks, , capturing of output in big string or something, output @ once, when thread terminates. issue (a) seems super inefficient, , (b) need capture stderr.

can see way keep output each thread separate?

clarification: desired output be:

componentafile1.cpp componentafile2.cpp componentafile3.cpp -------------------  #some separator componentbfile1.cpp componentbfile2.cpp -------------------  #some separator componentcfile1.cpp componentcfile2.cpp componentcfile3.cpp ... etc. 

to ensure output isn't interrupted, access stdout , stderr must mutually exclusive. means between time thread starts printing , finishes printing, no other thread can allowed print. can done using thread::semaphore^[1].

capturing output , printing @ once allows reduce amount of time thread holds lock. if don't that, you'll make system single-threaded system each thread attempts lock stdout , stderr while 1 thread runs.

other options include:

1. using different output file each thread.
2. prepending job id each line of output output can sorted later.

in both of cases, need lock short time span.

---

1. # once $mutex = thread::semaphore->new();  # shared threads.   # when want print. $mutex->down(); print ...; stdout->flush(); stderr->flush(); $mutex->up(); 

   or

   # once $mutex = thread::semaphore->new();  # shared threads. stdout->autoflush(); stderr->autoflush();   # when want print. $mutex->down(); print ...; $mutex->up();