better hardware info for Test::Smoke reports

[Abe Timmerman]

hi smokers,

First of all, the best wishes for 2004!

For the 1.19 release I want to introduce better hardware information in the 
smoke-reports. I have some systems I have access to, but most notably no AIX, 
HPUX or True64.

I would like you to test the attached script and fill in the blanks for me if 
you can.

comments and suggestions also welcome.

tia &&
Good luck,

Abe
-- 
Perl "configure" is not GNU configure, Perl is not "other GNU program".
Do not confuse one of Perl's licenses with the GNU project itself.
                                   -- Jarkko Hietaniemi on p5p @ 2002-05-27

#! /usr/bin/perl -w
use strict;

package SysInfo;

sub new {
    my $proto = shift;
    my $class = ref $proto ? ref $proto : $proto;

    CASE: {
        local $_ = $^O;

        /aix/i        && return bless AIX(),     $class;

        /darwin|bsd/i && return bless BSD(),     $class;

        /hp-?ux/i     && return bless HPUX(),    $class;

        /linux/i      && return bless Linux(),   $class;

        /irix/i       && return bless IRIX(),    $class;

        /solaris|sunos|osf/i 
                      && return bless Solaris(), $class;

        /cygwin|mswin32|windows/i
                      && return bless Windows(), $class;
    }
    return bless Generic(), $class;
}

my %info = map { ($_ => undef ) } qw( ncpu cpu cpu_type );

sub AUTOLOAD {
    my $self = shift;
    use vars qw( $AUTOLOAD );

    ( my $method = $AUTOLOAD ) =~ s/^.*::(.+)$/\L$1/;

    return $self->{ "_$method" } if exists $info{ "$method" };
}

sub __get_cpu_type {
    require POSIX;
    return (POSIX::uname())[4];
}

sub __get_cpu { return __get_cpu_type() }

sub __get_ncpu { return '?' }

sub Generic {

    return {
        _cpu_type => __get_cpu_type(),
        _cpu      => __get_cpu(),
        _ncpu     => __get_ncpu(),
    };

}

sub AIX {
    # here we need something with 'lsdev'?
    my $aix = Generic();
    $aix->{_ncpu} = scalar @{[ `lsdev -C -c processor -S Available` ]};
    return $aix;
}

sub HPUX {
    # here we need something with 'ioscan' ?
    my $hpux = Generic();
    $hpux->{_ncpu} = grep /^processor/ => `ioscan -fnkC processor`;
    return $hpux;
}

sub BSD {
    my %sysctl;
    foreach my $name ( qw( model machine ncpu ) ) {
        chomp( $sysctl{ $name } = `sysctl hw.$name` );
        $sysctl{ $name } =~ s/^hw\.$name\s*[:=]\s*//;
    }

    return {
        _cpu_type => $sysctl{model},
        _cpu      => $sysctl{machine},
        _ncpu     => $sysctl{ncpu},
    };
}

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 $ncpu = (split " ", $cpu_cnt)[0];
    my $type = (split " ", $cpu_cnt)[-2];

    return {
        _cpu_type => $type,
        _cpu      => $cpu,
        _ncpu     => $ncpu,
    };

}

sub Linux {
    local *CPUINFO;
    my( $type, $cpu, $ncpu ) = ( __get_cpu_type() );

    if ( open CPUINFO, "< /proc/cpuinfo" ) {
        chomp( my @cpu_info = <CPUINFO> );
        close CPUINFO;
        # every processor has its own 'block', so count the blocks
        $ncpu = grep /^processor\s+:\s+/ => @cpu_info;
        my %info;
        my @parts = $type =~ /sparc/
            ? ('cpu')
            : ('model name', 'vendor_id', 'cpu mhz' );
        foreach my $part ( @parts ) {

            ($info{ $part } = (grep /^$part\s+:/i => @cpu_info)[0]) 
                =~ s/^$part\s+:\s+//i;
        }
        $cpu = $type =~ /sparc/
            ? $info{cpu}
            : sprintf "%s (%s %sMHz)", map $info{ $_ } => @parts
    } else {
    }
    return {
        _cpu_type => $type,
        _cpu      => $cpu,
        _ncpu     => $ncpu,
    };
}

sub Solaris {

    my( $psrinfo ) = grep /the .* operates .* mhz/ix => `psrinfo -v`;
    my $type = __get_cpu_type();
    my( $cpu, $speed ) = $psrinfo =~ /the (\w+) processor.*at (\d+) mhz/i;
    $cpu .= " (${speed}MHz)";
    my $ncpu = grep /on-line/ => `psrinfo`;

    return {
        _cpu_type => $type,
        _cpu      => $cpu,
        _ncpu     => $ncpu,
    };
}

sub Windows {

    return {
        _cpu_type => $ENV{PROCESSOR_ARCHITECTURE},
        _cpu      => $ENV{PROCESSOR_IDENTIFIER},
        _ncpu     => $ENV{NUMBER_OF_PROCESSORS},
    };
}

1;

package main;

{
    local $^O = 'Generic';
    print "info for: '$^O'\n";
    my $si = SysInfo->new;
    printf "  CPU type:        %s\n", $si->cpu_type;
    printf "  CPU:             %s\n", $si->cpu;
    printf "  Number of cpu's: %s\n", $si->ncpu;
}

{
    print "info for: '$^O'\n";
    my $si = SysInfo->new;
    printf "  CPU type:        %s\n", $si->cpu_type;
    printf "  CPU:             %s\n", $si->cpu;
    printf "  Number of cpu's: %s\n", $si->ncpu;
}