Gecko [ www.jdcpatala.org ]

Name	Size	Permission
File	[ DIR ]	drwxr-xr-x
SafeProcess	[ DIR ]	drwxr-xr-x
Config.pm	9.98 KB	-rw-r--r--
ConfigFactory.pm	18.66 KB	-rw-r--r--
CoreDump.pm	8.98 KB	-rw-r--r--
Exec.pm	4.24 KB	-rw-r--r--
Find.pm	7.62 KB	-rw-r--r--
Handles.pm	2.04 KB	-rw-r--r--
Memcache.pm	26.33 KB	-rw-r--r--
Options.pm	4.19 KB	-rw-r--r--
Platform.pm	4.05 KB	-rw-r--r--
SafeProcess.pm	14.42 KB	-rw-r--r--
SysInfo.pm	5.45 KB	-rw-r--r--
Test.pm	3.81 KB	-rw-r--r--

Code Editor : SysInfo.pm

# -*- cperl -*-
# Copyright (c) 2008, 2022, Oracle and/or its affiliates.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License, version 2.0,
# as published by the Free Software Foundation.
#
# This program is also distributed with certain software (including
# but not limited to OpenSSL) that is licensed under separate terms,
# as designated in a particular file or component or in included license
# documentation.  The authors of MySQL hereby grant you an additional
# permission to link the program and your derivative works with the
# separately licensed software that they have included with MySQL.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License, version 2.0, for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

package My::SysInfo;

use strict;
use Carp;
use My::Platform;

use constant DEFAULT_BOGO_MIPS => 2000;

sub _cpuinfo {
  my ($self)= @_;

my $info_file= "/proc/cpuinfo";
  if ( !(  -e $info_file and -f $info_file) ) {
    return undef;
  }

my $F= IO::File->new($info_file) or return undef;

# Set input separator to blank line
  local $/ = '';

while ( my $cpu_chunk= <$F>) {
    chomp($cpu_chunk);

my $cpuinfo = {};

foreach my $cpuline ( split(/\n/, $cpu_chunk) ) {
      my ( $attribute, $value ) = split(/\s*:\s*/, $cpuline);

$attribute =~ s/\s+/_/;
      $attribute = lc($attribute);

if ( $value =~ /^(no|not available|yes)$/ ) {
	$value = $value eq 'yes' ? 1 : 0;
      }

if ( $attribute eq 'flags' ) {
	@{ $cpuinfo->{flags} } = split / /, $value;
      } else {
	$cpuinfo->{$attribute} = $value;
      }
    }

# Make sure bogomips is set to some value
    $cpuinfo->{bogomips} ||= DEFAULT_BOGO_MIPS;

# Cpus reported once, but with 'cpu_count' set to the actual number
    my $cpu_count= $cpuinfo->{cpu_count} || 1;
    for(1..$cpu_count){
      push(@{$self->{cpus}}, $cpuinfo);
    }
  }
  $F= undef; # Close file
  return $self;
}

sub _kstat {
  my ($self)= @_;
  while (1){
    my $instance_num= $self->{cpus} ? @{$self->{cpus}} : 0;
    my $list= `kstat -p -m cpu_info -i $instance_num 2> /dev/null`;
    my @lines= split('\n', $list) or last; # Break loop

my $cpuinfo= {};
    foreach my $line (@lines)
    {
      my ($module, $instance, $name, $statistic, $value)=
	$line=~ /(\w*):(\w*):(\w*):(\w*)\t(.*)/;

$cpuinfo->{$statistic}= $value;
    }

# Default value, the actual cpu values can be used to decrease this
    # on slower cpus
    $cpuinfo->{bogomips}= DEFAULT_BOGO_MIPS;

push(@{$self->{cpus}}, $cpuinfo);
  }

# At least one cpu should have been found
  # if this method worked
  if ( $self->{cpus} ) {
    return $self;
  }
  return undef;
}

sub _sysctl {
  my ($self)= @_;
  my $ncpu= `sysctl hw.ncpu 2> /dev/null`;
  if ($ncpu eq '') {
  return undef;
  }

my $cpuinfo= {};
  $ncpu =~ s/\D//g;
  my $list = `sysctl machdep.cpu | grep machdep\.cpu\.[^.]*: 2> /dev/null`;
  my @lines= split('\n', $list);

foreach my $line (@lines) {
    # Default value, the actual cpu values can be used to decrease this
    # on slower cpus
    $cpuinfo->{bogomips}= DEFAULT_BOGO_MIPS;

my ($statistic, $value)=
    $line=~ /machdep\.cpu\.(.*):\s+(.*)/;
    $cpuinfo->{$statistic}= $value;
  }

for (1..$ncpu) {
    my $temp_cpuinfo = $cpuinfo;
    $temp_cpuinfo->{processor}= $_;
    push(@{$self->{cpus}}, $temp_cpuinfo);
  }

# At least one cpu should have been found
  # if this method worked
  if ( $self->{cpus} ) {
    return $self;
  }
}

sub _unamex {
  my ($self)= @_;
  # TODO
  return undef;
}

sub new {
  my ($class)= @_;

my $self= bless {
		   cpus => (),
		  }, $class;

my @info_methods =
    (
     \&_cpuinfo,
     \&_kstat,
     \&_sysctl,
     \&_unamex,
   );

# Detect virtual machines
  my $isvm= 0;

if (IS_WINDOWS) {
    # Detect vmware service
    $isvm= `tasklist` =~ /vmwareservice/i;
  }
  $self->{isvm}= $isvm;

foreach my $method (@info_methods){
    if ($method->($self)){
      return $self;
    }
  }

# Push a dummy cpu
  push(@{$self->{cpus}},
     {
      bogomips => DEFAULT_BOGO_MIPS,
      model_name => "unknown",
     });

return $self;
}

# Return the list of cpus found
sub cpus {
  my ($self)= @_;
  return @{$self->{cpus}} or
    confess "INTERNAL ERROR: No cpus in list";
}

# Return the number of cpus found
sub num_cpus {
  if (IS_WINDOWS) {
    return $ENV{NUMBER_OF_PROCESSORS} || 1;
  }
  my ($self)= @_;
  return int(@{$self->{cpus}}) or
    confess "INTERNAL ERROR: No cpus in list";
}

# Return the smallest bogomips value amongst the processors
sub min_bogomips {
  my ($self)= @_;

my $bogomips;

foreach my $cpu (@{$self->{cpus}}) {
    if (!defined $bogomips or $bogomips > $cpu->{bogomips}) {
      $bogomips= $cpu->{bogomips};
    }
  }

return $bogomips;
}

sub isvm {
  my ($self)= @_;

return $self->{isvm};
}

# Prit the cpuinfo
sub print_info {
  my ($self)= @_;

foreach my $cpu (@{$self->{cpus}}) {
    while ((my ($key, $value)) = each(%$cpu)) {
      print " ", $key, "= ";
      if (ref $value eq "ARRAY") {
	print "[", join(", ", @$value), "]";
      } else {
	print $value;
      }
      print "\n";
    }
    print "\n";
  }
}

${this.title}

Code Editor : SysInfo.pm