Multithreading 是否有一种线程安全的方式在Perl中打印？

我目前有一个脚本，可以启动线程在几个目录上执行各种操作。我的脚本的一个片段是：

#main
sub BuildInit {

    my $actionStr = "";
    my $compStr   = "";

    my @component_dirs;
    my @compToBeBuilt;
    foreach my $comp (@compList) {
        @component_dirs = GetDirs($comp);    #populates @component_dirs
    }

    print "Printing Action List: @actionList\n";

    #---------------------------------------
    #----   Setup Worker Threads  ----------
    for ( 1 .. NUM_WORKERS ) {
        async {
            while ( defined( my $job = $q->dequeue() ) ) {
                worker($job);
            }
        };
    }

    #-----------------------------------
    #----   Enqueue The Work  ----------
    for my $action (@actionList) {
        my $sem = Thread::Semaphore->new(0);
        $q->enqueue( [ $_, $action, $sem ] ) for @component_dirs;

        $sem->down( scalar @component_dirs );
        print "\n------>> Waiting for prior actions to finish up... <<------\n";
    }

    # Nothing more to do - notify the Queue that we're not adding anything else
    $q->end();
    $_->join() for threads->list();

    return 0;
}

#worker
sub worker {
    my ($job) = @_;
    my ( $component, $action, $sem ) = @$job;
    Build( $component, $action );
    $sem->up();
}

#builder method
sub Build {

    my ( $comp, $action ) = @_;
    my $cmd     = "$MAKE $MAKE_INVOCATION_PATH/$comp ";
    my $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 is to link
        default { die "Action: $action is unknown to me." }
    }

    print "\n\t\t*** Performing Action: \'$cmd\' on $comp ***" if $verbose;

    if ( $action eq "link" ) {

        # hack around potential race conditions -- will only be an issue during linking
        my $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;
}

我考虑过使用backticks执行系统命令，并在一个大字符串中捕获所有输出，然后在线程终止时一次输出所有输出。但问题是（a）它似乎效率非常低，（b）我需要捕获

stderr

有人能找到一种方法来保持每个线程的输出是分开的吗

澄清： 我期望的结果是：

ComponentAFile1.cpp
ComponentAFile2.cpp
ComponentAFile3.cpp
-------------------  #some separator
ComponentBFile1.cpp
ComponentBFile2.cpp
-------------------  #some separator
ComponentCFile1.cpp
ComponentCFile2.cpp
ComponentCFile3.cpp
... etc.

---

如果试图将信号量计数器降至零以下，则可以利用

$sem->down

的阻塞行为，如中所述：

如果

down（）

尝试将计数器减至零以下，则会阻塞计数器 直到柜台足够大

---

下面是我们可以做的：

使用所有线程共享的计数器1初始化信号量 将线程计数器传递给

worker

和

Build

进入

->内部
构建
（而不是其他任何地方）
为了确保输出不被中断，对STDOUT和STDERR的访问必须是互斥的。这意味着在线程开始打印和完成打印之间，不允许其他线程打印。这可以使用Thread:：Semaphore[1]完成

捕获输出并一次全部打印可以减少线程持有锁的时间。如果您不这样做，您将有效地使您的系统成为单线程系统，因为在一个线程运行时，每个线程都试图锁定STDOUT和STDERR

其他选择包括：

为每个线程使用不同的输出文件
为每行输出预先添加作业id，以便以后可以对输出进行排序
在这两种情况下，您只需要在很短的时间内锁定它



或


我过去处理这个问题的方式不同，创建了一个
IO
线程，并使用它来序列化文件访问

例如

在线程内，通过以下方式“打印”：

$output_q -> enqueue ( "text_to_print\n"; );

带或不带包装器-例如，如果要将语句添加到日志，则用于时间戳语句。（您可能希望在排队时加时间戳，而不是在实际打印时加时间戳）
 第二个
..
包含打印语句和/或对
系统的调用，因此您的
..
和
up
的顺序错误，这意味着一次只能执行一个线程。我看不出有任何理由不在信号量块之前执行
系统
调用。因为您可能最终得到
系统从线程1的输出\n从系统从线程2的输出\n从系统从线程1的输出\n
，他在问如何避免。他的线程的输出是交错的，他想阻止这种情况发生。这一点很好。我太专注于传输位转移思想，以至于忘记了
系统
共享
标准输出
。哦，Well可以使用
$thr->tid（）
作为第二个suggestion@Zaid，作业ID会更有用，但是是的，线程ID也会做得很好。这非常有用，谢谢。我更新了我的原始问题，对我要做的事情做了一些澄清——我认为你的回答暗示了实现这一点的方法，特别是在一些标识符之前加上前缀，然后为输出排序。如果我误解了，请告诉我。不需要澄清；我已经正确理解了。IPC:：Run3（和IPC:：Run）使捕获STDOUT和STDERR变得很容易。
my $sem = Thread::Semaphore->new( 1 );

for my $thr_counter ( 1 .. NUM_WORKERS ) {
    async {
        while ( defined( my $job = $q->dequeue() ) ) {
            worker( $job, $thr_counter );
        }
    };
}

sub worker {
   my ( $job, $counter ) = @_;

   Build( $component, $action, $counter );
}

sub Build {
    my ( $comp, $action, $counter ) = @_;

    ... # Execute all concurrently-executed code here

    $sem->down( 1 << ( $counter -1 ) );

    print "\n\t\t*** Performing Action: \'$cmd\' on $comp ***" if $verbose;

    # Execute all sequential 'chunks' here

    $sem->up( 1 << ( $counter - 1) );
}

+-----------+---+---+---+---+
| Thread    | 1 | 2 | 3 | 4 |
+-----------+---+---+---+---+
| Semaphore | 1 | 2 | 4 | 8 |
+-----------+---+---+---+---+

# Once
my $mutex = Thread::Semaphore->new();  # Shared by all threads.


# When you want to print.
$mutex->down();
print ...;
STDOUT->flush();
STDERR->flush();
$mutex->up();

# Once
my $mutex = Thread::Semaphore->new();  # Shared by all threads.
STDOUT->autoflush();
STDERR->autoflush();


# When you want to print.
$mutex->down();
print ...;
$mutex->up();

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

sub writer {
    open ( my $output_fh, ">", $output_filename );
    while ( my $line = $output_q -> dequeue() ) {
        print {$output_fh} $line; 
    }
    close ( $output_fh );
 }

$output_q -> enqueue ( "text_to_print\n"; );