ONO::Core::HostOS
package ONO::Core::HostOS;
################################################################################
# COPYRIGHT / LICENSE #
################################################################################
#
# This file is part of the ONO Software Project.
#
# Copyright (C) 2000-2025 Jos KIRPS [ www.kirps.com | jos_AT_kirps_DOT_com ]
# and The Joopita Project [ www.joopita.org | contact_AT_joopita_DOT_com ]
#
# This file, as well as other parts of the ONO Software Project or related
# elements, are FREE SOFTWARE available under the ARTISTIC LICENSE 2.0.
#
# 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.
#
# For the full license, see /ono/osr/license/LICENSE.txt, or write to
# jos_AT_kirps_DOT_com or contact_AT_joopita_DOT_com.
#
################################################################################
# END OF COPYRIGHT / LICENSE, HERE COMES THE CODE ... #
################################################################################
use strict;
use ONO::IO;
use ONO::Core::Kernel;
#: ONO_Core_HostOS is responsible for low level communication with the host
#: operating system.
#:
#: Using this module in production projects should be avoided whenever
#: possible, try to use ONO::IO or other library / toolbox features instead.
###############################################################################
# Host OS
###############################################################################
my $HOSTOS = "BSD/UNIX";
if (-e "/Library/QuickTime") {
$HOSTOS = "MacOS";
}
sub host_os {
#: Returns the host os type, either BSD/UNIX or MacOS. This is required at
#: the ONO::Core level, as MacOS is different from other systems in some
#: ways. Linux distributions will simply be identified as BSD/UNIX systems.
return $HOSTOS;
}
###############################################################################
# CPAN
###############################################################################
sub cpan {
#: Returns a list of CPAN Perl Modules that are recommended for ONO, and
#: that are required for all ONO features to be fully functional.
#:
#: Switches:
#:
#: -H human readable information about requirements (HTML)
my ($CPAN,$err1,$err2);
foreach my $module (ONO::IO->list("ono/sys/ONO/Resources/PerlModules.txt")) {
$module =~ s~^(.*?):(.*)\n~$2~;
my $type = $1;
if ($_[1] =~ /H/) {
eval "use $module";
if (!$@) {
# $module = qq~<span class="green">$module</span>~;
} else {
if ($type eq "REQUIRED") {
$module = qq~<span class="lightred">$module</span>~;
$err1++;
}
if ($type eq "RECOMMENDED") {
$module = qq~<span class="orange">$module</span>~;
$err2++;
}
}
}
$CPAN .= "$module, ";
}
$CPAN =~ s~, $~~;
return ($CPAN,$err1,$err2);
}
###############################################################################
# SYSTEM INFO
###############################################################################
sub system {
#: Returns the host os type, plus some additional system information.
my $SYS;
if ($HOSTOS eq "MacOS") {
# maxosx
my @data = `sw_vers`;
foreach my $dat (@data) {
$dat =~ s~[^A-Za-z0-9\.\:]~~g;
if ($dat =~ s~ProductVersion:~~) {
$SYS = "MacOSX $dat";
}
}
} else {
# linux
my @data = `cat /etc/issue`;
foreach my $dat (@data) {
$dat =~ s~[^A-Za-z0-9\.\:\ \/]~~g;
if ($dat =~ m~(Linux|Ubuntu)~i) {
$SYS = $dat;
}
}
}
$SYS =~ s~[^A-Za-z0-9\ \-\.]~~gi;
if (!$SYS) {
$SYS = "BSD/UNIX";
}
return $SYS;
}
###############################################################################
# PERL INFO
###############################################################################
sub perl {
#: Return the current Perl version.
my @data = `perl -v`;
foreach my $dat (@data) {
$dat =~ s~[^A-Za-z0-9\.\:\ \/\,]~~g;
if ($dat =~ s~This is perl, v(.*?) built~~i) {
return "Perl $1";
}
}
}
###############################################################################
# WHO
###############################################################################
sub who {
#: List UNIX users who are currently online on the host OS.
my @who;
foreach my $line (`who`) {
my $ip;
if ($line =~ /\((.*?)\)/) {
$ip = $1;
}
$line =~ s~( |\n|\r|\t)(.*)$~~;
$line =~ s~( |\n|\r|\t)~~gi;
if ($ip) {
$line .= qq~ ($ip)~;
}
@who = (@who,$line);
}
return @who;
}
###############################################################################
# MYSQL INFO
###############################################################################
sub mysql {
#: Return the current MySQL version.
my $MYSQL = `mysql -V`;
# ubuntu:
if (!$MYSQL) {
$MYSQL = `/usr/bin/mysql -V`;
$MYSQL =~ s~^/usr/bin/mysql~~;
}
# macos:
if (!$MYSQL) {
$MYSQL = `/usr/local/mysql/bin/mysql -V`;
$MYSQL =~ s~^/usr/local/mysql/bin/mysql~~;
}
$MYSQL =~ s~(\n|\r|\t)~~gi;
$MYSQL =~ s~^ ~~gi;
$MYSQL =~ s~^ ~~gi;
return $MYSQL;
}
###############################################################################
# CPU LOAD STATISTICS
###############################################################################
# This uses mod_perl caching, as the output usually doesn't change quickly
my ($cpu_load_cached) = &cpu_load;
my $cpu_load_cached_time = time();
sub cpu_load_cached {
#: Return the current CPU load, which is being cached for 5 seconds.
#: This returns a scalar value, which is the current load.
if ($ENV{'MOD_PERL'} && time() > $cpu_load_cached_time + 4) {
($cpu_load_cached) = &cpu_load;
$cpu_load_cached_time = time();
}
return $cpu_load_cached;
}
sub cpu_load {
#: Return the current CPU load as an array (UNIX-like format).
my ($l1,$l2,$l3);
# detect the OS platform
if ($HOSTOS eq "MacOS") {
# if it's MacOSX:
my $loadavg = ONO::Core::Kernel->exec("/usr/sbin/sysctl vm.loadavg");
$loadavg =~ s~[^0-9\ \{\}]~~g;
$loadavg =~ m~\{ (.*?) (.*?) (.*?)\}~;
$l1 = $1;
$l2 = $2;
$l3 = $3;
} else {
# if it's Linux:
foreach my $load (ONO::Core::Kernel->sys("list","/proc/loadavg")) {
if ($load =~ /(.*?)\.(.*?) (.*?)\.(.*?) (.*?)\.(.*?) /) {
$l1 = "$1$2";
$l2 = "$3$4";
$l3 = "$5$6";
}
}
}
$l1 =~ s~[^0-9]~~g;
$l2 =~ s~[^0-9]~~g;
$l3 =~ s~[^0-9]~~g;
return ($l1,$l2,$l3);
}
###############################################################################
# CPU LOAD STATISTICS
###############################################################################
sub cpu_load_percent {
#: Return the current CPU load as percentage, taking multiple CPU cores and
#: multithreading into consideration.
#:
#: By default, this returns 3x percentage, 3x absolute, plus the number of
#: cores.
#:
#: -c current (returns string instead of array)
my $switches = $_[1];
my $cores = &cpu_cores;
my @load = &cpu_load;
my @per;
for (my $i = 0; $i < 3; $i++) {
$per[$i] = int(100/($cores*100)*$load[$i]);
}
if ($switches =~ /c/) {
return $per[0];
} else {
return ($per[0],$per[1],$per[2],$load[0],$load[1],$load[2],$cores);
}
}
###############################################################################
# CPU LOAD PASS
###############################################################################
sub cpu_load_pass {
#: CPU load threshold test, using the format cpu_load_pass(percent).
#:
#: Returns 1 if load LOWER than percent
#: Returns 0 if load HIGHER than percent
#:
#: Example: ONO_Core_HostOS->cpu_load_pass(50) will thus allow to execute
#: code if the ENTIRE load of the system is LOWER than 50 percent
#:
#: Don't use this function here if possible, use ONO::IO->sysload() instead.
if (&cpu_load_percent("","c") < $_[1]) {
return 1;
} else {
return 0;
}
}
###############################################################################
# SYSTEM STATUS
###############################################################################
sub system_status {
#: Return the current system status, or system health.
#:
#: Switches:
#:
#: -h human readable
#: -H human readable in colored box
my @per = &cpu_load_percent;
my (
$mem,
$used,
$free,
$mem_per1,
$mem_per2,
) = &mem_load;
if ($_[1] =~ /(h|H)/) {
my $STAT = "CPU/$per[6]: $per[3] ($per[0]%), $per[4] ($per[1]%), $per[5] ($per[2]%) / MEM: $used/$mem ($mem_per1%)";
if ($_[1] =~ /H/) {
my $color = "green";
if ($per[0] > 50) {
$color = "yellow";
}
if ($per[0] > 75) {
$color = "red";
}
$STAT = qq~<div class="box_$color pad10_2">$STAT</div>~;
}
return $STAT;
} else {
return (@per,$mem,$used,$free,$mem_per1,$mem_per2);
}
}
###############################################################################
# CPU CORES
###############################################################################
# This uses mod_perl caching, as the output usually doesn't change quickly
my $cores = &_cpu_cores;
sub cpu_cores {
#: Return the number of current CPU cores.
return $cores;
}
sub _cpu_cores {
#: Internal function, helps to detect CPU cores.
#: Don't use this, use cpu_cores() instead.
my $cores = 1;
# detect the OS platform
if (-e "/Library/Frameworks") {
$cores = `/usr/sbin/sysctl -n hw.ncpu`;
} else {
$cores = `grep ^processor /proc/cpuinfo | wc -l`;
}
$cores =~ s~[^0-9]~~g;
return $cores;
}
###############################################################################
# MEMORY
###############################################################################
sub mem {
#: Return current total memory of the system.
my ($mem) = &mem_load;
return $mem;
}
###############################################################################
# MEMORY
###############################################################################
sub mem_load_percent {
#: Return current memory load, as percentage.
my ($mem,$used) = &mem_load;
if ($mem && $used) {
return int(100/$mem*$used);
} else {
return 100;
}
}
###############################################################################
# MEMORY
###############################################################################
sub mem_load {
#: Return current memory load, detailed (total, used, free, percent,
#: percent).
my ($mem,$used,$free,$p1,$p2) = (0,0,0,0,0);
# detect the OS platform
if (-e "/Library/Frameworks") {
$mem = `/usr/sbin/sysctl -n hw.memsize`;
$mem = int($mem/1024/1024);
foreach my $line (`top -l 1`) {
if ($line =~ /^PhysMem: (.*?) used \((.*?) wired\), (.*?) unused\./) {
my $free = $3;
$free =~ s~[^0-9]~~;
$used = $mem - $free;
}
}
} else {
my ($fr,$bu,$ca);
foreach my $line (`more /proc/meminfo`) {
if ($line =~ /^MemTotal:(.*?)kB/) {
$mem = $1;
}
if ($line =~ /^MemFree:(.*?)kB/) {
$fr = $1;
}
if ($line =~ /^Buffers:(.*?)kB/) {
$bu = $1;
}
if ($line =~ /^Cached:(.*?)kB/) {
$ca = $1;
}
}
$used = int(($mem - $fr - $bu - $ca)/1024);
$mem = int($mem/1024);
}
$mem =~ s~[^0-9]~~g;
$used =~ s~[^0-9]~~g;
$free = $mem-$used;
if ($mem) {
$p1 = int(100/$mem*$used);
$p2 = int(100/$mem*$free);
}
return ($mem,$used,$free,$p1,$p2);
}
###############################################################################
# end of script
###############################################################################
1;
__END__
################################################################################
# COPYRIGHT / LICENSE #
################################################################################
#
# This file is part of the ONO Software Project.
#
# Copyright (C) 2000-2025 Jos KIRPS [ www.kirps.com | jos_AT_kirps_DOT_com ]
# and The Joopita Project [ www.joopita.org | contact_AT_joopita_DOT_com ]
#
# This file, as well as other parts of the ONO Software Project or related
# elements, are FREE SOFTWARE available under the ARTISTIC LICENSE 2.0.
#
# 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.
#
# For the full license, see /ono/osr/license/LICENSE.txt, or write to
# jos_AT_kirps_DOT_com or contact_AT_joopita_DOT_com.
#
################################################################################
# END OF COPYRIGHT / LICENSE, HERE COMES THE CODE ... #
################################################################################
use strict;
use ONO::IO;
use ONO::Core::Kernel;
#: ONO_Core_HostOS is responsible for low level communication with the host
#: operating system.
#:
#: Using this module in production projects should be avoided whenever
#: possible, try to use ONO::IO or other library / toolbox features instead.
###############################################################################
# Host OS
###############################################################################
my $HOSTOS = "BSD/UNIX";
if (-e "/Library/QuickTime") {
$HOSTOS = "MacOS";
}
sub host_os {
#: Returns the host os type, either BSD/UNIX or MacOS. This is required at
#: the ONO::Core level, as MacOS is different from other systems in some
#: ways. Linux distributions will simply be identified as BSD/UNIX systems.
return $HOSTOS;
}
###############################################################################
# CPAN
###############################################################################
sub cpan {
#: Returns a list of CPAN Perl Modules that are recommended for ONO, and
#: that are required for all ONO features to be fully functional.
#:
#: Switches:
#:
#: -H human readable information about requirements (HTML)
my ($CPAN,$err1,$err2);
foreach my $module (ONO::IO->list("ono/sys/ONO/Resources/PerlModules.txt")) {
$module =~ s~^(.*?):(.*)\n~$2~;
my $type = $1;
if ($_[1] =~ /H/) {
eval "use $module";
if (!$@) {
# $module = qq~<span class="green">$module</span>~;
} else {
if ($type eq "REQUIRED") {
$module = qq~<span class="lightred">$module</span>~;
$err1++;
}
if ($type eq "RECOMMENDED") {
$module = qq~<span class="orange">$module</span>~;
$err2++;
}
}
}
$CPAN .= "$module, ";
}
$CPAN =~ s~, $~~;
return ($CPAN,$err1,$err2);
}
###############################################################################
# SYSTEM INFO
###############################################################################
sub system {
#: Returns the host os type, plus some additional system information.
my $SYS;
if ($HOSTOS eq "MacOS") {
# maxosx
my @data = `sw_vers`;
foreach my $dat (@data) {
$dat =~ s~[^A-Za-z0-9\.\:]~~g;
if ($dat =~ s~ProductVersion:~~) {
$SYS = "MacOSX $dat";
}
}
} else {
# linux
my @data = `cat /etc/issue`;
foreach my $dat (@data) {
$dat =~ s~[^A-Za-z0-9\.\:\ \/]~~g;
if ($dat =~ m~(Linux|Ubuntu)~i) {
$SYS = $dat;
}
}
}
$SYS =~ s~[^A-Za-z0-9\ \-\.]~~gi;
if (!$SYS) {
$SYS = "BSD/UNIX";
}
return $SYS;
}
###############################################################################
# PERL INFO
###############################################################################
sub perl {
#: Return the current Perl version.
my @data = `perl -v`;
foreach my $dat (@data) {
$dat =~ s~[^A-Za-z0-9\.\:\ \/\,]~~g;
if ($dat =~ s~This is perl, v(.*?) built~~i) {
return "Perl $1";
}
}
}
###############################################################################
# WHO
###############################################################################
sub who {
#: List UNIX users who are currently online on the host OS.
my @who;
foreach my $line (`who`) {
my $ip;
if ($line =~ /\((.*?)\)/) {
$ip = $1;
}
$line =~ s~( |\n|\r|\t)(.*)$~~;
$line =~ s~( |\n|\r|\t)~~gi;
if ($ip) {
$line .= qq~ ($ip)~;
}
@who = (@who,$line);
}
return @who;
}
###############################################################################
# MYSQL INFO
###############################################################################
sub mysql {
#: Return the current MySQL version.
my $MYSQL = `mysql -V`;
# ubuntu:
if (!$MYSQL) {
$MYSQL = `/usr/bin/mysql -V`;
$MYSQL =~ s~^/usr/bin/mysql~~;
}
# macos:
if (!$MYSQL) {
$MYSQL = `/usr/local/mysql/bin/mysql -V`;
$MYSQL =~ s~^/usr/local/mysql/bin/mysql~~;
}
$MYSQL =~ s~(\n|\r|\t)~~gi;
$MYSQL =~ s~^ ~~gi;
$MYSQL =~ s~^ ~~gi;
return $MYSQL;
}
###############################################################################
# CPU LOAD STATISTICS
###############################################################################
# This uses mod_perl caching, as the output usually doesn't change quickly
my ($cpu_load_cached) = &cpu_load;
my $cpu_load_cached_time = time();
sub cpu_load_cached {
#: Return the current CPU load, which is being cached for 5 seconds.
#: This returns a scalar value, which is the current load.
if ($ENV{'MOD_PERL'} && time() > $cpu_load_cached_time + 4) {
($cpu_load_cached) = &cpu_load;
$cpu_load_cached_time = time();
}
return $cpu_load_cached;
}
sub cpu_load {
#: Return the current CPU load as an array (UNIX-like format).
my ($l1,$l2,$l3);
# detect the OS platform
if ($HOSTOS eq "MacOS") {
# if it's MacOSX:
my $loadavg = ONO::Core::Kernel->exec("/usr/sbin/sysctl vm.loadavg");
$loadavg =~ s~[^0-9\ \{\}]~~g;
$loadavg =~ m~\{ (.*?) (.*?) (.*?)\}~;
$l1 = $1;
$l2 = $2;
$l3 = $3;
} else {
# if it's Linux:
foreach my $load (ONO::Core::Kernel->sys("list","/proc/loadavg")) {
if ($load =~ /(.*?)\.(.*?) (.*?)\.(.*?) (.*?)\.(.*?) /) {
$l1 = "$1$2";
$l2 = "$3$4";
$l3 = "$5$6";
}
}
}
$l1 =~ s~[^0-9]~~g;
$l2 =~ s~[^0-9]~~g;
$l3 =~ s~[^0-9]~~g;
return ($l1,$l2,$l3);
}
###############################################################################
# CPU LOAD STATISTICS
###############################################################################
sub cpu_load_percent {
#: Return the current CPU load as percentage, taking multiple CPU cores and
#: multithreading into consideration.
#:
#: By default, this returns 3x percentage, 3x absolute, plus the number of
#: cores.
#:
#: -c current (returns string instead of array)
my $switches = $_[1];
my $cores = &cpu_cores;
my @load = &cpu_load;
my @per;
for (my $i = 0; $i < 3; $i++) {
$per[$i] = int(100/($cores*100)*$load[$i]);
}
if ($switches =~ /c/) {
return $per[0];
} else {
return ($per[0],$per[1],$per[2],$load[0],$load[1],$load[2],$cores);
}
}
###############################################################################
# CPU LOAD PASS
###############################################################################
sub cpu_load_pass {
#: CPU load threshold test, using the format cpu_load_pass(percent).
#:
#: Returns 1 if load LOWER than percent
#: Returns 0 if load HIGHER than percent
#:
#: Example: ONO_Core_HostOS->cpu_load_pass(50) will thus allow to execute
#: code if the ENTIRE load of the system is LOWER than 50 percent
#:
#: Don't use this function here if possible, use ONO::IO->sysload() instead.
if (&cpu_load_percent("","c") < $_[1]) {
return 1;
} else {
return 0;
}
}
###############################################################################
# SYSTEM STATUS
###############################################################################
sub system_status {
#: Return the current system status, or system health.
#:
#: Switches:
#:
#: -h human readable
#: -H human readable in colored box
my @per = &cpu_load_percent;
my (
$mem,
$used,
$free,
$mem_per1,
$mem_per2,
) = &mem_load;
if ($_[1] =~ /(h|H)/) {
my $STAT = "CPU/$per[6]: $per[3] ($per[0]%), $per[4] ($per[1]%), $per[5] ($per[2]%) / MEM: $used/$mem ($mem_per1%)";
if ($_[1] =~ /H/) {
my $color = "green";
if ($per[0] > 50) {
$color = "yellow";
}
if ($per[0] > 75) {
$color = "red";
}
$STAT = qq~<div class="box_$color pad10_2">$STAT</div>~;
}
return $STAT;
} else {
return (@per,$mem,$used,$free,$mem_per1,$mem_per2);
}
}
###############################################################################
# CPU CORES
###############################################################################
# This uses mod_perl caching, as the output usually doesn't change quickly
my $cores = &_cpu_cores;
sub cpu_cores {
#: Return the number of current CPU cores.
return $cores;
}
sub _cpu_cores {
#: Internal function, helps to detect CPU cores.
#: Don't use this, use cpu_cores() instead.
my $cores = 1;
# detect the OS platform
if (-e "/Library/Frameworks") {
$cores = `/usr/sbin/sysctl -n hw.ncpu`;
} else {
$cores = `grep ^processor /proc/cpuinfo | wc -l`;
}
$cores =~ s~[^0-9]~~g;
return $cores;
}
###############################################################################
# MEMORY
###############################################################################
sub mem {
#: Return current total memory of the system.
my ($mem) = &mem_load;
return $mem;
}
###############################################################################
# MEMORY
###############################################################################
sub mem_load_percent {
#: Return current memory load, as percentage.
my ($mem,$used) = &mem_load;
if ($mem && $used) {
return int(100/$mem*$used);
} else {
return 100;
}
}
###############################################################################
# MEMORY
###############################################################################
sub mem_load {
#: Return current memory load, detailed (total, used, free, percent,
#: percent).
my ($mem,$used,$free,$p1,$p2) = (0,0,0,0,0);
# detect the OS platform
if (-e "/Library/Frameworks") {
$mem = `/usr/sbin/sysctl -n hw.memsize`;
$mem = int($mem/1024/1024);
foreach my $line (`top -l 1`) {
if ($line =~ /^PhysMem: (.*?) used \((.*?) wired\), (.*?) unused\./) {
my $free = $3;
$free =~ s~[^0-9]~~;
$used = $mem - $free;
}
}
} else {
my ($fr,$bu,$ca);
foreach my $line (`more /proc/meminfo`) {
if ($line =~ /^MemTotal:(.*?)kB/) {
$mem = $1;
}
if ($line =~ /^MemFree:(.*?)kB/) {
$fr = $1;
}
if ($line =~ /^Buffers:(.*?)kB/) {
$bu = $1;
}
if ($line =~ /^Cached:(.*?)kB/) {
$ca = $1;
}
}
$used = int(($mem - $fr - $bu - $ca)/1024);
$mem = int($mem/1024);
}
$mem =~ s~[^0-9]~~g;
$used =~ s~[^0-9]~~g;
$free = $mem-$used;
if ($mem) {
$p1 = int(100/$mem*$used);
$p2 = int(100/$mem*$free);
}
return ($mem,$used,$free,$p1,$p2);
}
###############################################################################
# end of script
###############################################################################
1;
__END__