use strict;

use vars qw(%PREREQ %RECOMMEND);

use Module::Build;

do 'PREREQ' or die "Error including PREREQ: $@";

Module::Build->new(

   module_name => 'Sys::Info::Driver::Unknown',

   license     => 'perl',

   requires    => \%PREREQ,

   recommends  => \%RECOMMEND,

   sign        => 0,

   dist_author => 'Burak Gursoy <burak@cpan.org>',

)->create_build_script;

Revision history for Perl extension Sys::Info::Driver::Unknown.

Time zone is GMT+2.

0.69_01 Fri Feb 27 05:27:53 2009

    => Separation from Sys::Info.

lib/Sys/Info/Driver/Unknown/Device.pm

lib/Sys/Info/Driver/Unknown/OS.pm

lib/Sys/Info/Driver/Unknown/Device/CPU.pm

lib/Sys/Info/Driver/Unknown/Device/CPU/Env.pm

lib/Sys/Info/Driver/Unknown.pm

t/01-pod.t

t/02-pod-coverage.t

t/03-basic.t

Makefile.PL

Build.PL

Changes

MANIFEST

README

PREREQ

META.yml

use strict;

use vars qw(%PREREQ);

use ExtUtils::MakeMaker;

do 'PREREQ' or die "Error including PREREQ: $!";

WriteMakefile(

   'NAME'         => 'Sys::Info::Driver::Unknown',

   'VERSION_FROM' => 'lib/Sys/Info/Driver/Unknown.pm',

   'PREREQ_PM'    => \%PREREQ,

   ($] >= 5.005 ? (

   AUTHOR   => 'Burak Gursoy <burak@cpan.org>',

   ABSTRACT => 'Compatibility driver for Sys::Info',

   ) : ()),

   PL_FILES => {},

);

#!/usr/bin/perl -w

use strict;

use vars qw(%PREREQ %RECOMMEND);

%PREREQ = (

   'IO::File'        => 0,

   'Test::More'      => '0.40',

   'Sys::Info::Base' => '0.69_01',

);

1;

__END__

Sys::Info::Driver::Unknown

==========================

Fetch information about the host system.

Read the module's POD for documentation.

See the tests for examples.

INSTALLATION

To install this module type the following:

   perl Makefile.PL

   make

   make test

   make install

or under Windows:

   perl Makefile.PL

   nmake

   nmake test

   nmake install

COPYRIGHT

LICENSE

This library is free software; you can redistribute it and/or modify 

it under the same terms as Perl itself, either Perl version 5.8.8 or, 

at your option, any later version of Perl 5 you may have available.

package Sys::Info::Driver::Unknown;

use strict;

use vars qw( $VERSION );

$VERSION = '0.69_01';

1;

__END__

=head1 NAME

Sys::Info::Driver::Unknown - Compatibility driver for Sys::Info

=head1 SYNOPSIS

    use Sys::Info::Driver::Unknown;

=head1 DESCRIPTION

This is the main module in the C<Unknown> driver collection.

=head1 METHODS

None.

=head1 AUTHOR

=head1 COPYRIGHT

=head1 LICENSE

This library is free software; you can redistribute it and/or modify 

it under the same terms as Perl itself, either Perl version 5.8.8 or, 

at your option, any later version of Perl 5 you may have available.

=cut

package Sys::Info::Driver::Unknown::Device;

use strict;

use vars qw( $VERSION );

$VERSION = '0.60';

1;

__END__

=head1 NAME

Sys::Info::Driver::Unknown::Device - Base class for Unknown device drivers

=head1 SYNOPSIS

    use base qw( Sys::Info::Driver::Unknown::Device );

=head1 DESCRIPTION

Base class for Unknown device drivers.

=head1 METHODS

None.

=head1 AUTHOR

=head1 COPYRIGHT

=head1 LICENSE

This library is free software; you can redistribute it and/or modify 

it under the same terms as Perl itself, either Perl version 5.8.8 or, 

at your option, any later version of Perl 5 you may have available.

=cut

package Sys::Info::Driver::Unknown::Device::CPU;

use strict;

use vars qw($VERSION);

use base qw(Sys::Info::Driver::Unknown::Device::CPU::Env);

$VERSION = '0.60';

BEGIN {

    local $SIG{__DIE__};

    eval {

        require Unix::Processors;

        Unix::Processors->import;

        1;

    };

    my $UP = $@ ? 0 : 1;

    *_UPOK = sub {$UP};

}

sub load {0}

sub identify {

    my $self = shift;

    return $self->_serve_from_cache(wantarray) if $self->{CACHE};

    my @cpu;

    if ( _UPOK ) {

        my $up = Unix::Processors->new;

        foreach my $proc ( @{ $up->processors } ) {

            push @cpu, {

                data_width                   => undef,

                address_width                => undef,

                bus_speed                    => undef,

                speed                        => $proc->clock,

                name                         => $proc->type,

                family                       => undef,

                manufacturer                 => undef,

                model                        => undef,

                stepping                     => undef,

                number_of_cores              => $up->max_physical,

                number_of_logical_processors => $up->max_online,

                L1_cache                     => undef,

                flags                        => undef,

            };

        }

    } else {

        @cpu = $self->SUPER::identify(@_);

    }

    $self->{CACHE} = [ @cpu ];

    return $self->_serve_from_cache(wantarray);

}

1;

__END__

=head1 NAME

Sys::Info::Driver::Unknown::Device::CPU - Compatibility layer for unsupported platforms

=head1 SYNOPSIS

-

=head1 DESCRIPTION

L<Unix::Processors> is recommended for

unsupported platforms.

=head1 METHODS

=head2 identify

See identify in L<Sys::Info::Device::CPU>.

=head2 load

See load in L<Sys::Info::Device::CPU>.

=head1 SEE ALSO

L<Sys::Info>, L<Sys::Info::CPU>, L<Unix::Processors>.

=head1 AUTHOR

=head1 COPYRIGHT

=head1 LICENSE

This library is free software; you can redistribute it and/or modify 

it under the same terms as Perl itself, either Perl version 5.8.8 or, 

at your option, any later version of Perl 5 you may have available.

=cut

package Sys::Info::Driver::Unknown::Device::CPU::Env;

use strict;

use vars qw( $VERSION );

$VERSION = '0.60';

my(%INTEL, %AMD, %OTHER_ID, %OTHER, %CPU, $INSTALLED);

sub identify {

    my $self = shift;

    return $self->_serve_from_cache(wantarray) if $self->{CACHE};

    $self->_INSTALL() if not $INSTALLED;

    if ( not $CPU{id} ) {

        $self->{CACHE} = []; # fake

        return;

    }

    my($cpu, $count, @cpu);

    if ($CPU{id} =~ /(.+?), (?:Genuine(Intel)|Authentic(AMD))/) {

        my $cid  = $1;

        my $corp = $2 || $3;

        if ( my %info = $self->_parse( $cid ) ) {

            if ( my $mn = $self->_corp( $corp, $info{Family} ) ) {

                if ( my $name = $mn->{ $info{Model} } ) {

                    $count = ($CPU{number} && $CPU{number} > 1) ? $CPU{number} : '';

                    $cpu   = "$corp $name";

                }

            }

        }

    }

    foreach my $other (keys %OTHER_ID) {

        if ($CPU{id} =~ /\Q$other/) {

            $cpu = $OTHER_ID{$other};

        }

    }

    $count = 1 if not $count;

    for ( 1..$count ) {

        push @cpu, {

            architecture  => ($CPU{id} =~ m{ \A (.+?) \s? Family }xmsi),

            data_width    => undef,

            speed         => undef,

            bus_speed     => undef,

            address_width => undef,

            name          => $cpu,

        };

    }

    $self->{CACHE} = [@cpu];

    return $self->_serve_from_cache(wantarray);

}

# ------------------------[ P R I V A T E ]------------------------ #

sub _INSTALL {

    my $self   = shift;

    %INTEL     = _INTEL();

    %AMD       = _AMD();

    %OTHER_ID  = _OTHER_ID();

    %OTHER     = _OTHER();

    %CPU       = (                              # PIV 3.0 GHz HT

        id     => $ENV{PROCESSOR_IDENTIFIER},   # x86 Family 15 Model 3 Stepping 3, GenuineIntel

        number => $ENV{NUMBER_OF_PROCESSORS},   # 2

        arch   => $ENV{PROCESSOR_ARCHITECTURE}, # x86

        rev    => $ENV{PROCESSOR_REVISION},     # 0303

        level  => $ENV{PROCESSOR_LEVEL},        # 15

    );

    if ( ! $CPU{id} && $self->can('__env_pi') ) {

        $CPU{id} = $self->__env_pi;

    }

    $INSTALLED = 1;

}

sub _corp {

    my $self   = shift;

    my $corp   = shift;

    my $family = shift;

    return $INTEL{$family} if $corp eq 'Intel';

    return $AMD{$family}   if $corp eq 'AMD';

}

sub _parse {

    my $self = shift;

    my $id   = shift;

    my $arch = $CPU{arch};

    if ($id =~ /$arch\s(.+?)$/) {

        my %h = split /\s+/, $1; # Family Model Stepping

        for my $k (keys %h) {

            $h{$k} = '' unless defined $h{$k};

        }

        return %h;

    }

}

sub _INTEL {

   # Family  Model    Name

    4  => {

            0     => '486 DX-25/33',

            1     => '486 DX-50',

            2     => '486 SX',

            3     => '486 DX/2',

            4     => '486 SL',

            5     => '486 SX/2',

            7     => '486 DX/2-WB',

            8     => '486 DX/4',

            9     => '486 DX/4-WB',

    },

    5  => {

            0     => 'Pentium 60/66 A-step',

            1     => 'Pentium 60/66',

            2     => 'Pentium 75 - 200',

            3     => 'OverDrive PODP5V83',

            4     => 'Pentium MMX',

            7     => 'Mobile Pentium 75 - 200',

            8     => 'Mobile Pentium MMX',

    },

    6  => {

            0     => 'Pentium Pro A-step',

            1     => 'Pentium Pro',

            3     => 'Pentium II (Klamath)',

            5     => 'Pentium II (Deschutes), Celeron (Covington), Mobile Pentium II (Dixon)',

            6     => 'Mobile Pentium II, Celeron (Mendocino)',

            7     => 'Pentium III (Katmai)',

            8     => 'Pentium III (Coppermine)',

            9     => 'Mobile Pentium III',

            13    => 'Celeron M', # ???

            15    => 'Core 2 Duo (Merom)', # ???

    },

    7  => {

            0     => 'Itanium (IA-64)',

    },

    15 => {

            # Itanium 2 (IA-64)?

    },

}

sub _AMD {

    # Family  Model    Name

    4  => {

        3     => '486 DX/2',

        7     => '486 DX/2-WB',

        8     => '486 DX/4',

        9     => '486 DX/4-WB',

        14    => 'Am5x86-WT',

        15    => 'Am5x86-WB',

    },

    5  => {

        0     => 'K5/SSA5',

        1     => 'K5',

        2     => 'K5',

        3     => 'K5',

        6     => 'K6',

        7     => 'K6',

        8     => 'K6-2',

        9     => 'K6-3',

        13    => 'K6-2+ or K6-III+',

    },

    6  => {

        3     => 'Duron',

        4     => 'Athlon (Thunderbird)',

        6     => 'Athlon (Palamino)',

        7     => 'Duron (Morgan)',

        8     => 'Athlon (Thoroughbred)',

        10    => 'Athlon (Barton)',

    },

    15 => {

        4     => 'Athlon 64',

        5     => 'Athlon 64 FX Opteron',

    },

}

sub _OTHER_ID {

    # Vendor          Manufacturer Name

    'CyrixInstead' => 'Cyrix',

    'CentaurHauls' => 'Centaur',

    'NexGenDriven' => 'NexGen',

    'GenuineTMx86' => 'Transmeta',

    'RiseRiseRise' => 'Rise',

    'UMC UMC UMC'  => 'UMC',

    'SiS SiS SiS'  => 'SiS',

    'Geode by NSC' => 'National Semiconductor',

}

sub _OTHER {

    Cyrix => {

    # Family Model Name

        4 => {

            4 => 'MediaGX',

        },

        5 => {

            2 => '6x86 / 6x86L (Identifying the difference)',

            4 => 'MediaGX MMX Enhanced',

        },

        6 => {

            0 => 'm II (6x86MX)',

            5 => 'VIA Cyrix M2 core',

            6 => 'WinChip C5A',

            7 => 'WinChip C5B ,WinChip C5C',

            8 => 'WinChip C5N',

            9 => 'WinChip C5XL, WinChip C5P',

        },

    },

    UMC => {

        4 => {

            1 => 'U5D',

            2 => 'U5S',

        },

    },

    Centaur => {

        5 => {

            4 => 'C6',

            8 => 'C2',

            9 => 'C3',

        },

    },

    'National Semiconductor' => {

        5 => {

            4 => 'GX1, GXLV, GXm',

            5 => 'GX2',

        },

    },

    NexGen => {

        5 => {

            0 => 'Nx586',

        },

    },

    Rise => {

        5 => {

            0 => 'mP6',

            1 => 'mP6',

        },

    },

    SiS => {

        5 => {

            0 => '55x',

        }

    },

    Transmeta => {

        5 => {

            4 => 'Crusoe TM3x00 and TM5x00',

        },

    },

}

1;

__END__

=head1 NAME

Sys::Info::Driver::Unknown::Device::CPU::Env - Fetch CPU information from %ENV

=head1 SYNOPSIS

Nothing public here.

=head1 DESCRIPTION

These C<%ENV> keys are recognised by this module:

   PROCESSOR_IDENTIFIER

   NUMBER_OF_PROCESSORS

   PROCESSOR_ARCHITECTURE

   PROCESSOR_REVISION

   PROCESSOR_LEVEL

=head1 METHODS

=head2 identify

See identify in L<Sys::Info::Device::CPU>.

=head2 load

See load in L<Sys::Info::Device::CPU>.

=head1 SEE ALSO

L<Sys::Info>,

L<http://www.sandpile.org/>,

L<http://www.paradicesoftware.com/specs/cpuid/index.htm>.

=head1 AUTHOR

=head1 COPYRIGHT

=head1 LICENSE

This library is free software; you can redistribute it and/or modify 

it under the same terms as Perl itself, either Perl version 5.8.8 or, 

at your option, any later version of Perl 5 you may have available.

=cut

package Sys::Info::Driver::Unknown::OS;

use strict;

use vars qw( $VERSION );

use POSIX ();

use Sys::Info::Constants qw( :unknown );

$VERSION = '0.60';

# So, we don't support $^O yet, but we can try to emulate some features

BEGIN {

    *is_root     = *uptime

                 = *tick_count

                 = sub { 0 }

                 ;

    *domain_name = *edition

                 = *logon_server

                 = sub {   }

                 ;

}

sub meta {

    my $self = shift;

    my %info;

    $info{manufacturer}              = undef;

    $info{build_type}                = undef;

    $info{owner}                     = undef;

    $info{organization}              = undef;

    $info{product_id}                = undef;

    $info{install_date}              = undef;

    $info{boot_device}               = undef;

    $info{physical_memory_total}     = undef;

    $info{physical_memory_available} = undef;

    $info{page_file_total}           = undef;

    $info{page_file_available}       = undef;

    # windows specific

    $info{windows_dir}               = undef;

    $info{system_dir}                = undef;

    $info{system_manufacturer}       = undef;

    $info{system_model}              = undef;

    $info{system_type}               = undef;

    $info{page_file_path}            = undef;

    return %info;

}

sub tz {

    my $self = shift;

    return exists $ENV{TZ} ? $ENV{TZ} : undef;

}

sub fs { +() }

sub name {

    my $self  = shift;

    my %opt   = @_ % 2 ? () : (@_);

    my @uname = POSIX::uname();

    my $rv    = $opt{long} ? join(' ', @uname[UN_OS_SYSNAME, UN_OS_RELEASE])

              :              $uname[UN_OS_SYSNAME]

              ;

    return $rv;

}

sub version { (POSIX::uname)[UN_OS_RELEASE] }

sub build {

    my $build = (POSIX::uname)[UN_OS_VERSION] || return;

    if ( $build =~ UN_RE_BUILD ) {

        return $1;

    }

    return $build;

}

sub node_name { (POSIX::uname)[UN_OS_NODENAME] }

sub login_name {

    my $name;

    eval { $name = getlogin() };

    return $name;

}

1;

__END__

=head1 NAME

Sys::Info::Driver::Unknown::OS - Compatibility layer for unsupported platforms

=head1 SYNOPSIS

-

=head1 DESCRIPTION

-

=head1 METHODS

Please see L<Sys::Info::OS> for definitions of these methods and more.

=head2 build

=head2 domain_name

=head2 edition

=head2 fs

=head2 is_root

=head2 login_name

=head2 logon_server

=head2 meta

=head2 name

=head2 node_name

=head2 tick_count

=head2 tz

=head2 uptime

=head2 version

=head1 SEE ALSO

L<Sys::Info>, L<Sys::Info::OS>.

=head1 AUTHOR

=head1 COPYRIGHT

=head1 LICENSE

This library is free software; you can redistribute it and/or modify 

it under the same terms as Perl itself, either Perl version 5.8.8 or, 

at your option, any later version of Perl 5 you may have available.

=cut

#!/usr/bin/env perl -w

use strict;

use Test::More;

my @errors;

eval { require Test::Pod; };

push @errors, "Test::Pod is required for testing POD"   if $@;

eval { require Pod::Simple; };

push @errors, "Pod::Simple is required for testing POD" if $@;

if ( not @errors ) {

   my $tpv = $Test::Pod::VERSION;

   my $psv = $Pod::Simple::VERSION;

   if ( $tpv < 1.26 ) {

      push @errors, "Upgrade Test::Pod to 1.26 to run this test. "

                   ."Detected version is: $tpv";

   }

   if ( $psv < 3.05 ) {

      push @errors, "Upgrade Pod::Simple to 3.05 to run this test. "

                   ."Detected version is: $psv";

   }

}

if ( $] < 5.008 ) {

   # Any older perl does not have Encode.pm. Thus, Pod::Simple

   # can not handle utf8 encoding and it will die, the tests

   # will fail. This skip part, skips an inevitable failure.

   push @errors, "'=encoding utf8' directives in Pods don't work "

                ."with legacy perl.";

}

if ( @errors ) {

   plan skip_all => "Errors detected: @errors";

}

else {

   Test::Pod::all_pod_files_ok();

}

#!/usr/bin/env perl -w

use strict;

use Test::More;

eval q{use Test::Pod::Coverage; 1;};

if ( $@ ) {

    plan skip_all => "Test::Pod::Coverage required for testing pod coverage";

}

else {

   all_pod_coverage_ok();

}

#!/usr/bin/env perl -w

use strict;

use Test::More qw( no_plan );

ok(1);

1;