view release on metacpan or  search on metacpan

system-limits.PL  view on Meta::CPAN

# try to guess how many processors this system has.
# Eventually we could use that information to set
# a default value of $Forks::Super::MAX_PROC in the
# installed code.
#
# See also: Sys::CpuAffinity getNumCpus() method
#           Forks::Super::Job::OS::get_number_of_processors() method
#
sub count_number_of_cpus {
    $DARWIN && print STDERR "  in count_number_of_cpus\n";

    my ($ncpu, $fh);
    return if $LIMITS{'sys|ncpu'};

    $ncpu = 0;
    my $sys = 0;
    if (eval "require Sys::CpuAffinity; 1") {
	$ncpu = Sys::CpuAffinity::getNumCpus();

	# darwin: result might have format "1 [2 cores]"
	$ncpu =~ s{\d+ \[(\d+) cores\]}{$1};
        $sys = !!$ncpu;
    }
    if ($ncpu == 0 && eval "require Test::Smoke::SysInfo;1") {
	my $sysinfo = Test::Smoke::SysInfo->new();
	$ncpu = $sysinfo && $sysinfo->{_ncpu};
        $sys = !!$ncpu;
    }

    if ($ncpu == 0 && $^O eq "MSWin32") {
	$ncpu = $ENV{NUMBER_OF_PROCESSORS};
        $sys = !$ncpu;
    }
    if ($ncpu == 0 && open($fh,'<','/proc/cpuinfo')) {
	$ncpu = grep /^processor\s/, <$fh>;
	close $fh;
        $sys = !!$ncpu;
    }
    if ($ncpu == 0 && open($fh,'<','/proc/stat')) {
	$ncpu = grep /^cpu\d/i, <$fh>;
	close $fh;
        $sys = !!$ncpu;
    }
    if ($ncpu == 0) {
	$ncpu = grep /\d+.+processors?$/i, qx(hinv -c processor 2>/dev/null);
        $sys =!!$ncpu;
    }
    if ($ncpu == 0) {
	$ncpu = () = qx(bindprocessor -q 2>/dev/null);
        $sys =!!$ncpu;
    }
    if ($ncpu == 0) {
	$ncpu = grep /^hw.ncpu:/, qx(sysctl -a 2>/dev/null);
        $sys =!!$ncpu;
    }
    if ($ncpu == 0) {
	$ncpu = () = qx(psrinfo 2> /dev/null);
        $sys =!!$ncpu;
    }
    if ($ncpu == 0) {
	$ncpu = qx(hwprefs cpu_count 2>/dev/null);
        $sys =!!$ncpu;
    }

    if ($ncpu && $ncpu > 0) {
	print "There are $ncpu cpus on this system.\n";
        if ($sys) {
            write_limits( 'sys|ncpu' => $ncpu + 0 );
        } else {
            write_limits( ncpu => $ncpu + 0 );
        }
    } else {
	print "I am having trouble detecting the number\n";
	print "of processors on your system. Consider\n";
	print "installing the  Sys::CpuAffinity  module\n";
	print "before running this script.\n";
	write_limits( ncpu => "1.0" );
    }
}

# does this host have a simple way to conduct the remote tests (t/49*.t)?
sub probe_ssh_test_env {
    $DARWIN && print STDERR "  in probe_ssh_test_env\n";

    return if $LIMITS{'test_ssh_target'};
    write_limits( 'test_ssh_target', '0');

    my $ENV_USER = $ENV{USER} || 'xxxxx';
    my $ENV_HOST = $ENV{HOSTNAME} || 'xhxhxhxh';
    chomp(my $hostname = qx(hostname));
    $hostname ||= 'knknknknknk';
    my $ip = eval "use Sys::HostAddr;1" 
             ? Sys::HostAddr->new->main_ip : "299.1.1.1";

#   foreach my $host ('$ENV_HOST', '$ip', 'localhost', '$hostname') {
# 'localhost' never works :-(    
    foreach my $host ('$ENV_HOST', '$ip', '$hostname') {
        foreach my $user ('$ENV_USER','') {

            my $cmdtmp = "ssh -o BatchMode=yes";
            if ($user) {
                $cmdtmp .= " -l $user";
            }
            $cmdtmp .= " $host";

            my $cmd = $cmdtmp;
            $cmd =~ s/\$ENV_USER/$ENV_USER/;
            $cmd =~ s/\$ENV_HOST/$ENV_HOST/;
            $cmd =~ s/\$hostname/$hostname/;
            $cmd =~ s/\$ip/$ip/;
            my $token = sprintf "%06X", rand() * 0xFFFFFF;

            my $null = $^O eq 'MSWin32' ? 'nul' : '/dev/null';
            my $ssh_output = qx($cmd echo $token < $null 2> $null);
            my $ssh_status = $?;
            chomp($ssh_output);

            if ($ssh_output eq $token && $ssh_status == 0) {
                print STDERR "Suitable ssh test configuration: $cmdtmp\n";
                write_limits('test_ssh_target', $cmdtmp);
                return;