为什么我的 Perl 脚本没有使用所有 CPU 内核？

Question

显然该脚本只使用了一个 CPU 内核，而机器有四个。是我的代码还是其他设置？我是 Perl 新手。

#!/usr/bin/perl

use strict;
use warnings;
use threads;
use threads::shared;
use Thread::Queue;
use DBI();
use File::Touch;

my $databasefile = "/var/www/deamon/new.db";
my $count        = touch($databasefile);

my $dbuser        = "****";
my $dbpwd         = "****";
my $dbhost        = "localhost";
my $dbname        = "****";
my $max_threads   = 16;
my $queue_id_list = Thread::Queue->new;
my @childs;

#feeds entries to the queue list
my $ArrayMonitor = threads->new(\&URLArrayMonitor, $queue_id_list);
sleep 3;    #make sure system has enough time to connect and load up array

#start 10 crawler threads (these are the work horses)
my $CrawlerThreads = ();
for (0 .. $max_threads) {
    $CrawlerThreads->[$_] = threads->new(\&NameChecker, $queue_id_list);

    #print "Crawler " . ($_ + 1) . " created.\n";
}

#print "Letting threads run until queue is empty.\n";

while ($queue_id_list->pending > 0) {
    sleep .01;
}

sleep 1;

foreach my $thr (threads->list) {

    # don't join the main or ourselves
    if ($thr->tid && !threads::equal($thr, threads->self)) {

        #print "Waiting for thread " . $thr->tid . " to join\n";
        #print "Thread " . $thr->join . " has joined.\n";
        sleep .01;
    }
}

sub URLArrayMonitor {
    my ($queue_id_list) = @_;

    #**********************************************
    # here we walk though all users / select database and check what needs to be checked
    #**********************************************
    my $dbh = DBI->connect("DBI:mysql:database=" . $dbname . ";host=" . $dbhost, $dbuser, $dbpwd, {'RaiseError' => 1});
    my $sth = $dbh->prepare("SELECT * FROM ci_users WHERE user_group >= 10 ORDER BY user_id");
    $sth->execute();
    while (my $ref = $sth->fetchrow_hashref()) {

        # now we check the user if there are names we need to check
        print "Now checking relian_user_" . $ref->{'user_id'} . "\r\n";
        eval {
            my $dbuser
              = DBI->connect("DBI:mysql:database=user_" . $ref->{'user_id'} . ";host=" . $dbhost, $dbuser, $dbpwd, {'RaiseError' => 1});
            my $stuser = $dbuser->prepare("SELECT * FROM ci_address_book WHERE lastchecked=0");    #select only new
            $stuser->execute();
            while (my $entry = $stuser->fetchrow_hashref()) {
                my @queueitem = ($ref->{'user_id'} . "#" . $entry->{'id'});
                $queue_id_list->enqueue(@queueitem);
            }
            $stuser->finish();
            $dbuser->disconnect();
        };
        warn "failed to connect - $dbuser->errstr" if ($@);
    }
    $sth->finish();
    $dbh->disconnect();
    print "List now contains " . $queue_id_list->pending . " records.\n";
    sleep 1;
}

sub NameChecker {
    my ($queue_id_list) = @_;
    while ($queue_id_list->pending > 0) {
        my $info = $queue_id_list->dequeue_nb;
        if (defined($info)) {
            my @details      = split(/#/, $info);
            my $result       = system("/var/www/deamon/NewScan/match_name db=" . $details[0] . " id=" . $details[1]);
            my $databasefile = "/var/www/deamon/new.db";
            my $count        = touch($databasefile);

            #print "Thread: ". threads->self->tid. " - Done user: ".$details[0]. " and addressbook id: ". $details[1]."\r\n";
            #print $queue_id_list->pending."\r\n";
        }
    }

    #print "Crawler " . threads->self->tid . " ready to exit.\n";

    return threads->self->tid;
}

Answer 1

您在每个线程中执行的任务看起来并不占用大量 CPU。他们是吗？ &URLArrayMonitor 使用数据库资源，但除非数据库与 Perl 脚本位于同一台机器上，否则不会占用大量 CPU。我无法判断&NameChecker 中的外部程序可能使用哪些资源，但根据您的 cmets，它看起来可能会使用大量网络带宽；再次没有很多CPU。因此，如果您可以在单核上运行此脚本，您应该不会感到太惊讶。

如果你想测试多线程程序是否在使用多核，试着给它一个 CPU 密集型任务：

use threads;
use Math::BigInt;
threads->new(sub {print new Math::BigInt($_[0])->bfac()}, 400000) for 1..10;
print `uptime` while sleep 5;