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

Question

我目前有一个脚本可以启动线程以在多个目录上执行各种操作.我的脚本片段是:

#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;
}

在print我想是线程安全的说法是:print "\n\t\t*** Performing Action: \'$cmd\' on $comp ***" if $verbose;理想情况下,我想有这样的输出,然后将所具有的每个组件$action上进行,会在相关的块输出.但是,这显然现在不起作用 - 输出大部分都是交错的,每个线程都会自己输出信息.

例如,:

ComponentAFile1.cpp
ComponentAFile2.cpp
ComponentAFile3.cpp
ComponentBFile1.cpp
ComponentCFile1.cpp
ComponentBFile2.cpp
ComponentCFile2.cpp
ComponentCFile3.cpp
... etc.

我考虑使用反引号执行系统命令,并捕获大字符串或其他内容中的所有输出,然后在线程终止时立即输出所有输出.但问题是(a)它看起来效率极低,而且(b)我需要捕获stderr.

任何人都可以看到一种方法来保持每个线程的输出分开？

澄清: 我想要的输出是:

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

Answer 1

为确保输出不会中断,对STDOUT和STDERR的访问必须是互斥的.这意味着在线程开始打印和完成打印之间,不允许其他线程打印.这可以使用Thread :: Semaphore ^[1]完成.

捕获输出并立即打印所有内容可以减少线程锁定的时间.如果你不这样做,你将有效地建立你的系统单线程系统,因为每个线程在一个线程运行时尝试锁定STDOUT和STDERR.

其他选择包括:

1. 为每个线程使用不同的输出文件.
2. 将作业ID预先添加到每行输出,以便稍后对输出进行排序.

在这两种情况下,您只需要在很短的时间内锁定它.

1. # 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();