Why is my Perl script not using all CPU cores?

Apparently the script only utilizes one CPU core, while the machine has four. Is it my code or some other setting? I am new to 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 o开发者_JS百科urselves
    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;
}

---

The tasks you are performing in each thread don't look that CPU intensive. Are they? The &URLArrayMonitor uses database resources, but that won't use a lot of CPU unless the database is on the same machine as the Perl script. I can't tell what resources the external program in &NameChecker is likely to use, but based on your comments it looks like it may use a lot of network bandwidth; again not a lot of CPU. So you shouldn't be too surprised if you can run this script on a single core.

If you want to test whether multi-threaded programs are using multiple cores, try giving it a CPU-intensive task:

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