How about this for a start
a5:/pro/3gl/CPAN/TS-1.19 138 > perl -Ilib -MTest::Smoke::SysInfo -MData::Dumper
-e'print Dumper (Test::Smoke::SysInfo::HPUX ())'
$VAR1 = {
'_cpu_type' => 'PA-2.0/64',
'_host' => 'a5',
'_ncpu' => 2,
'_os' => 'HP-UX 11.00/64',
'_cpu' => 'PA8700'
};
a5:/pro/3gl/CPAN/TS-1.19 139 >
i2:/a5/pro/3gl/CPAN/TS-1.19 122 > perl -Ilib -MTest::Smoke::SysInfo -MData::Dumper
-e'print Dumper (Test::Smoke::SysInfo::AIX ())'
$VAR1 = {
'_cpu_type' => 'PPC/32',
'_host' => 'i2',
'_ncpu' => 1,
'_os' => 'AIX 4.3.3.0/ML11/32',
'_cpu' => 'PPC_604e'
};
i2:/a5/pro/3gl/CPAN/TS-1.19 123 >
lt09:/pro/3gl/CPAN/TS-1.19 109 > perl -Ilib -MTest::Smoke::SysInfo -MData::Dumper
-e'print Dumper (Test::Smoke::SysInfo::Linux ())'
$VAR1 = {
'_cpu_type' => 'i686',
'_host' => 'lt09',
'_ncpu' => 1,
'_os' => 'Linux 2.4.20-4GB',
'_cpu' => 'Intel(R) Pentium(R) M processor 1400MHz (GenuineIntel 1396MHz)'
};
lt09:/pro/3gl/CPAN/TS-1.19 108 >
Then the mail header could be something like
"\L$si->{_os}\E ($si->{_ncpu} $si->{_cpu} $si->{_cpu_type} [EMAIL
PROTECTED]>{_ncpu}==1?'':'s']})"
hpux 11.00/64 (2 PA8700 PA-2.0/64 cpus)
aix 4.3.3.0/ML11/32 (1 PPC_604e PPC/32 cpu)
linux 2.4.20-4gb (1 Intel(R) Pentium(R) M processor 1400MHz (GenuineIntel 1396MHz)
i686 cpu)
But mabe you want to strip that linux cpu somewhat more
--- lib/Test/Smoke/SysInfo.pm.org 2004-01-07 14:39:15.000000000 +0100
+++ lib/Test/Smoke/SysInfo.pm 2004-01-07 15:50:53.000000000 +0100
@@ -70,6 +70,17 @@ sub AUTOLOAD {
return $self->{ "_$method" } if exists $info{ "$method" };
}
+=item __get_os( )
+
+This is the short info string about the Operating System.
+
+=cut
+
+sub __get_os {
+ require POSIX;
+ return "@{[(POSIX::uname())[0,2]]}";
+}
+
=item __get_cpu_type( )
This is the short info string about the cpu-type. The L<POSIX> module
@@ -113,6 +124,7 @@ Get the information from C<POSIX::uname(
sub Generic {
return {
+ _os => __get_os(),
_cpu_type => __get_cpu_type(),
_cpu => __get_cpu(),
_ncpu => __get_ncpu(),
@@ -128,15 +140,47 @@ Use the L<lsdev> program to find informa
=cut
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+)/;
my( $cpu ) = grep /^enable:[^:\s]+/ => `lsattr -E -O -l $info`;
( $cpu ) = $cpu =~ /^enable:([^:\s]+)/;
+ $cpu =~ s/\bPowerPC(?=\b|_)/PPC/i;
+ (my $cpu_type = $cpu) =~ s/_.*//;
+
+ chomp (my $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";
+ print STDERR "l";
+ 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 /;
+ 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 {
- _cpu_type => $cpu,
- _cpu => $cpu
+ _os => $os,
+ _cpu_type => $cpu_type,
+ _cpu => $cpu,
_ncpu => scalar @lsdev,
_host => __get_hostname(),
};
@@ -149,11 +193,41 @@ Use the L<ioscan> program to find inform
=cut
sub HPUX {
- # here we need something with 'ioscan' ?
my $hpux = Generic();
- $hpux->{_ncpu} = grep /^processor/ => `ioscan -fnkC processor`;
+ my $ncpu = grep /^processor/ => `ioscan -fnkC processor`;
+ unless ($ncpu) { # not root?
+ if (open my $lst, "< /var/adm/syslog/syslog.log") {
+ while (<$lst>) {
+ m/\bprocessor$/ and $ncpu++;
+ }
+ }
+ }
+ $hpux->{_ncpu} = $ncpu;
+ # http://wtec.cup.hp.com/~cpuhw/hppa/hversions.html
+ my (@cpu, $lst);
+ chomp (my $model = `model`);
+ (my $m = $model) =~ s:.*/::;
+ open $lst, "</usr/sam/lib/mo/sched.models" and
+ @cpu = grep m/$m/i, <$lst>;
+ @cpu == 0 && open $lst, "</opt/langtools/lib/sched.models" and
+ @cpu = grep m/$m/i, <$lst>;
+ 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, $_;
+ }
+ }
+ $hpux->{_os} =~ s/ B\./ /;
+ chomp (my $k64 = `getconf KERNEL_BITS`);
+ $k64 and $hpux->{_os} .= "/$k64";
+ if ($cpu[0] =~ m/^\S+\s+(\d+\.\d+)\s+(\S+)/) {
+ my ($arch, $cpu) = ("PA-$1", $2);
+ $hpux->{_cpu} = $cpu;
+ $hpux->{_cpu_type} = `getconf HW_32_64_CAPABLE` =~ m/^1/ ? "$arch/64" :
"$arch/32";
+ }
return $hpux;
-}
+ }
=item BSD( )
@@ -173,6 +247,7 @@ sub BSD {
_cpu => $sysctl{model},
_ncpu => $sysctl{ncpu},
_host => __get_hostname(),
+ _os => __get_os(),
};
}
@@ -195,6 +270,7 @@ sub IRIX {
_cpu => $cpu,
_ncpu => $ncpu,
_host => __get_hostname(),
+ _os => __get_os(),
};
}
@@ -246,6 +322,7 @@ sub Linux {
_cpu => $cpu,
_ncpu => $ncpu,
_host => __get_hostname(),
+ _os => __get_os(),
};
}
@@ -268,6 +345,7 @@ sub Solaris {
_cpu => $cpu,
_ncpu => $ncpu,
_host => __get_hostname(),
+ _os => __get_os(),
};
}
@@ -286,6 +364,7 @@ sub Windows {
_cpu => $ENV{PROCESSOR_IDENTIFIER},
_ncpu => $ENV{NUMBER_OF_PROCESSORS},
_host => __get_hostname(),
+ _os => __get_os(),
};
}
--
H.Merijn Brand Amsterdam Perl Mongers (http://amsterdam.pm.org/)
using perl-5.6.1, 5.8.0, & 5.9.x, and 806 on HP-UX 10.20 & 11.00, 11i,
AIX 4.3, SuSE 8.2, and Win2k. http://www.cmve.net/~merijn/
http://archives.develooper.com/[EMAIL PROTECTED]/ [EMAIL PROTECTED]
send smoke reports to: [EMAIL PROTECTED], QA: http://qa.perl.org
