| Test-Smoke documentation | Contained in the Test-Smoke distribution. |
Test::Smoke::SysInfo - OO interface to system specific information
use Test::Smoke::SysInfo;
my $si = Test::Smoke::SysInfo->new;
printf "Hostname: %s\n", $si->host;
printf "Number of CPU's: %s\n", $si->ncpu;
printf "Processor type: %s\n", $si->cpu_type; # short
printf "Processor description: %s\n", $si->cpu; # long
printf "OS and version: %s\n", $si->os;
or
use Test::Smoke::SysInfo qw( sysinfo );
printf "[%s]\n", sysinfo();
or
$ perl -MTest::Smoke::SysInfo=tsuname -le print+tsuname
Sometimes one wants a more eleborate description of the system one is smoking.
Dispatch to one of the OS-specific subs.
This is the short info string about the Operating System.
This is the short info string about the cpu-type. The POSIX module
should provide one (portably) with POSIX::uname().
We do not have a portable way to get this information, so assign
_cpu_type to it.
Get the hostname from POSIX::uname().
Get the information from POSIX::uname()
Use the lsdev program to find information.
Use the ioscan, getconf and machinfo programs to find information.
This routine was contributed by Rich Rauenzahn.
Use the sysctl program to find information.
If the system_profiler program is accessible (meaning that this is Mac OS X), use it to find information; otherwise treat as BSD.
This sub was donated by Dominic Dunlup.
Use the hinv program to get the system information.
Helper function to get information from /proc/cpuinfo
Use the /proc/cpuinfo pseudofile to get the system information.
Linux on sparc architecture seems too different from intel
Linux on ppc architecture seems too different from intel
Use the psrinfo program to get the system information. Used also in Tru64 (osf).
Use the %ENV hash to find information. Fall back on the *::Generic
values if these values have been unset or are unavailable (sorry I do
not have Win9[58]).
Use Win32::TieRegistry if available to get better information.
Use some VMS specific stuff to get system information. These were suggested by Craig Berry.
sysinfo() returns a string with host, os and cpu_type.
This class gathers most of the uname(1) info, make a comparable
version. Takes almost the same arguments:
a for all (can be omitted)
n for nodename
s for os name and version
m for cpu name
c for cpu count
p for cpu_type
(c) 2002-2006, Abe Timmerman <abeltje@cpan.org> All rights reserved.
With contributions from Jarkko Hietaniemi, Merijn Brand, Campo Weijerman, Alan Burlison, Allen Smith, Alain Barbet, Dominic Dunlop, Rich Rauenzahn, David Cantrell.
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
See:
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.
| Test-Smoke documentation | Contained in the Test-Smoke distribution. |
package Test::Smoke::SysInfo; use strict; # $Id: SysInfo.pm 1284 2010-11-01 18:12:17Z abeltje $ use vars qw( $VERSION @EXPORT_OK ); $VERSION = '0.042'; use base 'Exporter'; @EXPORT_OK = qw( &sysinfo &tsuname );
sub new { my $proto = shift; my $class = ref $proto ? ref $proto : $proto; my $chk_os; for $chk_os ( $^O ) { $chk_os =~ /aix/i && return bless AIX(), $class; $chk_os =~ /bsd/i && return bless BSD(), $class; $chk_os =~ /darwin/i && return bless Darwin(), $class; $chk_os =~ /hp-?ux/i && return bless HPUX(), $class; $chk_os =~ /linux/i && return bless Linux(), $class; $chk_os =~ /irix/i && return bless IRIX(), $class; $chk_os =~ /solaris|sunos|osf/i && return bless Solaris(), $class; $chk_os =~ /cygwin|mswin32|windows/i && return bless Windows(), $class; $chk_os =~ /VMS/ && return bless VMS(), $class; } return bless Generic(), $class; } my %info = map { ($_ => undef ) } qw( os ncpu cpu cpu_type host ); sub AUTOLOAD { my $self = shift; use vars qw( $AUTOLOAD ); ( my $method = $AUTOLOAD ) =~ s/^.*::(.+)$/\L$1/; return $self->{ "_$method" } if exists $info{ "$method" }; }
sub __get_os { require POSIX; my $os = join " - ", (POSIX::uname())[0,2]; $os =~ s/(\S+)/\L$1/; my $chk_os; for $chk_os ( $^O ) { $chk_os =~ /aix/i && do { chomp( $os = `oslevel -r` ); if ( $os =~ m/^(\d+)-(\d+)$/ ) { $os = ( join ".", split //, $1 ) . "/ML$2"; } else { chomp( $os = `oslevel` ); # And try figuring out at what maintainance level we are my $ml = "00"; for ( grep m/ML\b/ => `instfix -i` ) { if ( m/All filesets for (\S+) were found/ ) { $ml = $1; $ml =~ m/^\d+-(\d+)_AIX_ML/ and $ml = "ML$1"; next; } $ml =~ s/\+*$/+/; } $os .= "/$ml"; } $os =~ s/^/AIX - /; last; }; $chk_os =~ /irix/i && do { chomp( my $osvers = `uname -R` ); my( $osn, $osv ) = split ' ', $os; $osvers =~ s/^$osv\s+(?=$osv)//; $os = "$osn - $osvers"; last; }; $chk_os =~ /linux/i && do { my $dist_re = '[-_](?:release|version)\b'; my( $distro ) = grep /$dist_re/ && !/\blsb-/ => glob( '/etc/*' ); last MOREOS unless $distro; $distro =~ s|^/etc/||; $distro =~ s/$dist_re//i; $os .= " [$distro]" if $distro; last; }; $chk_os =~ /solaris|sunos|osf/i && do { my( $osn, $osv ) = (POSIX::uname())[0,2]; $chk_os =~ /solaris|sunos/i && $osv > 5 and do { $osn = 'Solaris'; $osv = '2.' . (split /\./, $osv, 2)[1]; }; $os = join " - ", $osn, $osv; last; }; $chk_os =~ /windows|mswin32/i && do { eval { require Win32 }; $@ and last MOREOS; $os = "$^O - " . join " ", Win32::GetOSName(); $os =~ s/Service\s+Pack\s+/SP/; last; }; $chk_os =~ /vms/i && do { $os = join " - ", (POSIX::uname())[0,3]; $os =~ s/(\S+)/\L$1/; }; } return $os; }
sub __get_cpu_type { require POSIX; return (POSIX::uname())[4]; }
sub __get_cpu { return __get_cpu_type() }
sub __get_hostname { require POSIX; return (POSIX::uname())[1]; } sub __get_ncpu { return '' }
sub Generic { return { _os => __get_os(), _cpu_type => __get_cpu_type(), _cpu => __get_cpu(), _ncpu => __get_ncpu(), _host => __get_hostname(), }; }
sub AIX { local $ENV{PATH} = "$ENV{PATH}:/usr/sbin"; my @lsdev = grep /Available/ => `lsdev -C -c processor -S Available`; my( $info ) = grep /^\S+/ => @lsdev; ( $info ) = $info =~ /^(\S+)/; $info .= " -a 'state type'"; my( $cpu ) = grep /\benable:[^:\s]+/ => `lsattr -E -O -l $info`; ( $cpu ) = $cpu =~ /\benable:([^:\s]+)/; $cpu =~ s/\bPowerPC(?=\b|_)/PPC/i; ( my $cpu_type = $cpu ) =~ s/_.*//; my $os = __get_os(); if ( $> == 0 ) { chomp( my $k64 = `bootinfo -K 2>/dev/null` ); $k64 and $os .= "/$k64"; chomp( my $a64 = `bootinfo -y 2>/dev/null` ); $a64 and $cpu_type .= "/$a64"; } return { _os => $os, _cpu_type => $cpu_type, _cpu => $cpu, _ncpu => scalar @lsdev, _host => __get_hostname(), }; }
sub HPUX { my $hpux = Generic(); my $parisc = 0; $hpux->{_os} =~ s/hp-ux/HP-UX/; # ioscan is always available $hpux->{_ncpu} = grep /^processor/ => `/usr/sbin/ioscan -knfCprocessor`; chomp(my $k64 = `/usr/bin/getconf KERNEL_BITS 2>/dev/null`); $hpux->{_os} .= "/$k64" if(length $k64); # For now, unknown cpu_types are set as the Generic chomp(my $cv = `/usr/bin/getconf CPU_VERSION 2>/dev/null`); # see /usr/include/sys/unistd.h for hex values if($cv < 0x20B) { # $hpux->{_cpu_type} = sprintf("Unknown CPU_VERSION 0x%x", $cv); } elsif($cv >= 0x20C && $cv <= 0x20E) { $hpux->{_cpu_type} = "Motorola"; # You have an antique } elsif($cv <= 0x2FF) { $hpux->{_cpu_type} = "PA-RISC"; $hpux->{_cpu_type} = "PA-RISC1.0" if $cv == 0x20B; $hpux->{_cpu_type} = "PA-RISC1.1" if $cv == 0x210; $hpux->{_cpu_type} = "PA-RISC1.2" if $cv == 0x211; $hpux->{_cpu_type} = "PA-RISC2.0" if $cv == 0x214; $parisc++; } elsif($cv == 0x300) { # $hpux->{_cpu_type} = "Itanium,archrev0"; $hpux->{_cpu_type} = "ia64"; } else { # $hpux->{_cpu_type} = sprintf("Unknown CPU_VERSION 0x%x", $cv); } if ( $parisc ) { my( @cpu, $lst ); chomp( my $model = `model` ); ( my $m = $model ) =~ s:.*/::; local *LST; my $f; foreach $f (qw( /usr/sam/lib/mo/sched.models /opt/langtools/lib/sched.models )) { if ( open LST, "< $f" ) { @cpu = grep m/$m/i => <LST>; close LST; @cpu and last; } } if (@cpu == 0 && open my $lst, "echo 'sc product cpu;il' | /usr/sbin/cstm |") { while (<$lst>) { s/^\s*(PA)\s*(\d+)\s+CPU Module.*/$m 1.1 $1$2/ or next; $2 =~ m/^8/ and s/ 1.1 / 2.0 /; push @cpu, $_; } } if (@cpu and $cpu[0] =~ m/^\S+\s+(\d+\.\d+[a-z]?)\s+(\S+)/) { my( $arch, $cpu ) = ( "PA-RISC$1", $2 ); $hpux->{_cpu} = $cpu; chomp( my $hw3264 = `/usr/bin/getconf HW_32_64_CAPABLE 2>/dev/null` ); (my $osvers = $hpux->{_os}) =~ s/.*[AB]\.//; $osvers =~ s{/.*}{}; $osvers <= 10.20 and $hw3264 = 0; if ( $hw3264 == 1 ) { $hpux->{_cpu_type} = $arch . "/64"; } elsif ( $hw3264 == 0 ) { $hpux->{_cpu_type} = $arch . "/32"; } } } else { my $machinfo = `/usr/contrib/bin/machinfo`; if ( $machinfo =~ m/processor model:\s+(\d+)\s+(.*)/ ) { $hpux->{_cpu} = $2; } elsif ( $machinfo =~ m{\s*[0-9]+\s+(intel.r.*processor)\s*\(([0-9.]+)\s*([GM])Hz.*}mi) { my ($m, $s, $h) = ($1, $2, $3); $m =~ s: series processor::; $h eq "G" and $s = int ($s * 1024); $hpux->{_cpu} = "$m/$s"; } if ( $machinfo =~ m/Clock\s+speed\s+=\s+(.*)/ ) { $hpux->{_cpu} .= "/$1"; } } return $hpux; }
sub BSD { my %sysctl; my $sysctl_cmd = -x '/sbin/sysctl' ? '/sbin/sysctl' : 'sysctl'; my %extra = ( cpufrequency => undef, cpuspeed => undef ); my @e_args = map { /^hw\.(\w+)\s*[:=]/; $1 } grep /^hw\.(\w+)/ && exists $extra{ $1 } => `$sysctl_cmd -a hw`; foreach my $name ( qw( model machine ncpu ), @e_args ) { chomp( $sysctl{ $name } = `$sysctl_cmd hw.$name` ); $sysctl{ $name } =~ s/^hw\.$name\s*[:=]\s*//; } $sysctl{machine} and $sysctl{machine} =~ s/Power Macintosh/macppc/; my $cpu = $sysctl{model}; if ( exists $sysctl{cpuspeed} ) { $cpu .= sprintf " (%.0f MHz)", $sysctl{cpuspeed}; } elsif ( exists $sysctl{cpufrequency} ) { $cpu .= sprintf " (%.0f MHz)", $sysctl{cpufrequency}/1_000_000; } return { _cpu_type => ($sysctl{machine} || __get_cpu_type()), _cpu => $cpu || __get_cpu, _ncpu => $sysctl{ncpu}, _host => __get_hostname(), _os => __get_os(), }; }
sub Darwin { my $system_profiler_output; { local $^W = 0; $system_profiler_output = `/usr/sbin/system_profiler -detailLevel mini SPHardwareDataType`; } return BSD() unless $system_profiler_output; my %system_profiler; $system_profiler{$1} = $2 while $system_profiler_output =~ m/^\s*([\w ]+):\s+(.+)$/gm; # convert newer output from Intel core duo my %keymap = ( 'Processor Name' => 'CPU Type', 'Processor Speed' => 'CPU Speed', 'Model Name' => 'Machine Name', 'Model Identifier' => 'Machine Model', 'Number Of Processors' => 'Number Of CPUs', ); for my $newkey ( keys %keymap ) { my $oldkey = $keymap{ $newkey }; exists $system_profiler{ $newkey} and $system_profiler{ $oldkey } = delete $system_profiler{ $newkey }; } $system_profiler{'CPU Type'} =~ s/PowerPC\s*(\w+).*/macppc$1/; $system_profiler{'CPU Speed'} =~ s/(0(?:\.\d+)?)\s*GHz/sprintf("%d MHz", $1 * 1000)/e; my $model = $system_profiler{'Machine Name'} || $system_profiler{'Machine Model'}; my $ncpu = $system_profiler{'Number Of CPUs'}; $system_profiler{'Total Number Of Cores'} and $ncpu .= " [$system_profiler{'Total Number Of Cores'} cores]"; return { _cpu_type => ($system_profiler{'CPU Type'} || __get_cpu_type()), _cpu => ("$model ($system_profiler{'CPU Speed'})" || __get_cpu), _ncpu => $ncpu, _host => __get_hostname(), _os => __get_os() . " (Mac OS X)", }; }
sub IRIX { chomp( my( $cpu ) = `hinv -t cpu` ); $cpu =~ s/^CPU:\s+//; chomp( my @processor = `hinv -c processor` ); my( $cpu_cnt ) = grep /\d+.+processors?$/i => @processor; my( $cpu_mhz ) = $cpu_cnt =~ /^\d+ (\d+ MHZ) /; my $ncpu = (split " ", $cpu_cnt)[0]; my $type = (split " ", $cpu_cnt)[-2]; return { _cpu_type => $type, _cpu => $cpu . " ($cpu_mhz)", _ncpu => $ncpu, _host => __get_hostname(), _os => __get_os(), }; }
sub __from_proc_cpuinfo { my( $key, $lines ) = @_; my( $value ) = grep /^\s*$key\s*[:=]\s*/i => @$lines; defined $value or $value = ""; $value =~ s/^\s*$key\s*[:=]\s*//i; return $value; }
sub Linux { my( $type, $cpu, $ncpu ) = ( __get_cpu_type() ); ARCH: { $type =~ /sparc/ and return Linux_sparc( $type ); $type =~ /ppc/i and return Linux_ppc( $type ); } local *CPUINFO; if ( open CPUINFO, "< /proc/cpuinfo" ) { chomp( my @cpu_info = <CPUINFO> ); close CPUINFO; $ncpu = grep /^processor\s+:\s+/ => @cpu_info; my @parts = ( 'model name', 'vendor_id', 'cpu mhz' ); my %info = map { ( $_ => __from_proc_cpuinfo( $_, \@cpu_info ) ); } @parts; $cpu = sprintf "%s (%s %.0fMHz)", map $info{ $_ } => @parts; my $ncores = 0; for my $cores ( grep /cpu cores\s*:\d+/ => @cpu_info ) { $ncores += $cores =~ /(\d+)/ ? $1 : 0; } $ncores and $ncpu .= " [$ncores cores]"; } else { $cpu = __get_cpu(); } $cpu =~ s/\s+/ /g; return { _cpu_type => $type, _cpu => $cpu, _ncpu => $ncpu, _host => __get_hostname(), _os => __get_os(), }; }
sub Linux_sparc { my( $type, $cpu, $ncpu ) = @_; local *CPUINFO; if ( open CPUINFO, "< /proc/cpuinfo" ) { chomp( my @cpu_info = <CPUINFO> ); close CPUINFO; $ncpu = __from_proc_cpuinfo( 'ncpus active', \@cpu_info ); my @parts = qw( cpu Cpu0ClkTck ); my %info = map { ( $_ => __from_proc_cpuinfo( $_, \@cpu_info ) ); } @parts; $cpu = $info{cpu}; $info{Cpu0ClkTck} and $cpu .= sprintf " (%.0fMHz)", hex( $info{Cpu0ClkTck} )/1_000_000; } else { $cpu = __get_cpu(); } $cpu =~ s/\s+/ /g; return { _cpu_type => $type, _cpu => $cpu, _ncpu => $ncpu, _host => __get_hostname(), _os => __get_os(), }; }
sub Linux_ppc { my( $type, $cpu, $ncpu ) = @_; local *CPUINFO; if ( open CPUINFO, "< /proc/cpuinfo" ) { chomp( my @cpu_info = <CPUINFO> ); close CPUINFO; $ncpu = grep /^processor\s+:\s+/ => @cpu_info; my @parts = qw( cpu machine clock ); my %info = map { ( $_ => __from_proc_cpuinfo( $_, \@cpu_info ) ); } @parts; if ($info{detected} = __from_proc_cpuinfo( 'detected as', \@cpu_info )){ $info{detected} =~ s/.*(\b.+Mac G\d).*/$1/; $info{machine} = $info{detected}; } $cpu = sprintf "%s %s (%s)", map $info{ $_ } => @parts; } else { $cpu = __get_cpu(); } $cpu =~ s/\s+/ /g; return { _cpu_type => $type, _cpu => $cpu, _ncpu => $ncpu, _host => __get_hostname(), _os => __get_os(), }; }
sub Solaris { local $ENV{PATH} = "/usr/sbin:$ENV{PATH}"; my @psrinfo = `psrinfo -v`; my( $psrinfo ) = grep /the .* operates .* [gm]hz/ix => @psrinfo; my( $type, $speed, $magnitude ) = $psrinfo =~ /the (.+) processor.*at (.+?)\s*([GM]hz)/i; $type =~ s/(v9)$/ $1 ? "64" : ""/e; my $cpu = __get_cpu(); if ( -d "/usr/platform" ) { # Solaris but not OSF/1. chomp( my $platform = `uname -i` ); my $pfpath = "/usr/platform/$platform/sbin/prtdiag"; if ( -x "$pfpath" ) { # Not on Solaris-x86 my $prtdiag = `$pfpath`; ( $cpu ) = $prtdiag =~ /^System .+\(([^\s\)]+)/; unless ( $cpu ) { my($cpu_line) = grep /\s+on-?line\s+/i => split /\n/, $prtdiag; ( $cpu = ( split " ", $cpu_line )[4] ) =~ s/.*,//; } $cpu .= " ($speed$magnitude)"; } else { $cpu .= " ($speed$magnitude)"; } } elsif (-x "/usr/sbin/sizer") { # OSF/1. $cpu = $type; chomp( $type = `sizer -implver` ); } my $ncpu = grep /on-?line/ => `psrinfo`; return { _cpu_type => $type, _cpu => $cpu, _ncpu => $ncpu, _host => __get_hostname(), _os => __get_os(), }; }
sub Windows { my( $cpu_type, $cpu, $ncpu ); eval { require Win32::TieRegistry }; unless ( $@ ) { Win32::TieRegistry->import(); my $Registry = $Win32::TieRegistry::Registry->Open( "", { Access => 0x2000000 } ); my $basekey = join "\\", qw( LMachine HARDWARE DESCRIPTION System CentralProcessor ); my $pnskey = "$basekey\\0\\ProcessorNameString"; my $cpustr = $Registry->{ $pnskey }; my $idkey = "$basekey\\0\\Identifier"; $cpustr ||= $Registry->{ $idkey }; $cpustr =~ tr/ / /s; my $mhzkey = "$basekey\\0\\~MHz"; $cpustr .= sprintf "(~%d MHz)", hex $Registry->{ $mhzkey }; $cpu = $cpustr; $ncpu = keys %{ $Registry->{ $basekey } }; ($cpu_type) = $Registry->{ $idkey } =~ /^(\S+)/; } return { _cpu_type => ( $cpu_type || $ENV{PROCESSOR_ARCHITECTURE} ), _cpu => ( $cpu || $ENV{PROCESSOR_IDENTIFIER} ), _ncpu => ( $ncpu || $ENV{NUMBER_OF_PROCESSORS} ), _host => __get_hostname(), _os => __get_os(), }; }
sub VMS { my $vms = Generic(); # my $myname = $vms->{_host}; # my @cpu_brief = `SHOW CPU/BRIEF`; # my( $sysline ) = grep /$myname,(?:\s+a)?\s+/i => @cpu_brief; # my( $cpu ) = $sysline =~ /$myname,(?:\s+a)?\s+(.+)/i; # my $ncpu = grep /^CPU \d+/ && /\bstate\b/i && /\bRUN\b/i => @cpu_brief; my %map = ( cpu => 'HW_NAME', cpu_type => 'ARCH_NAME', ncpu => 'ACTIVECPU_CNT' ); for my $key ( keys %map ) { my $cmd_out = `write sys\$output f\$getsyi("$map{$key}")`; chomp( $vms->{ "_$key" } = $cmd_out ); } return $vms; }
sub sysinfo { my $si = Test::Smoke::SysInfo->new; my @fields = $_[0] ? qw( host os cpu ncpu cpu_type ) : qw( host os cpu_type ); return join " ", @{ $si }{ map "_$_" => @fields }; }
sub tsuname { my $si; ref $_[0] eq __PACKAGE__ and $si = shift; my @args = map split() => @_; my @sw = qw( n s m c p ); my %sw = ( n => '_host', s => '_os', m => '_cpu', c => '_ncpu', p => '_cpu_type' ); @args = grep exists $sw{ $_ } => @args; @args or @args = ( 'a' ); grep( /a/ => @args ) and @args = @sw; my %show = map +( $_ => undef ) => grep exists $sw{ $_ } => @args; @args = grep exists $show{ $_ } => @sw; defined $si or $si = Test::Smoke::SysInfo->new; return join " ", @{ $si }{ @sw{ @args } }; } 1;