File Coverage

blib/lib/Devel/Platform/Info.pm

Criterion	Covered	Total	%
statement	25	25	100.0
branch	1	2	50.0
condition	1	2	50.0
subroutine	5	5	100.0
pod	2	2	100.0
total	34	36	94.4

package Devel::Platform::Info;

use strict;
use warnings;

use vars qw($VERSION);
$VERSION = '1.00';

#----------------------------------------------------------------------------

my %map = (
    # Unix (and like) family OSes
    'freebsd'       => 'BSD',
    'openbsd'       => 'BSD',
    'netbsd'        => 'BSD',
    'mirbsd'        => 'BSD',
    'dragonfly'     => 'BSD',
    'midnightbsd'   => 'BSD',

    'irix'          => 'Irix',

    'linux'         => 'Linux',
    'aix'           => 'Linux',
    'bsdos'         => 'Linux',
    'dgux'          => 'Linux',
    'dynixptx'      => 'Linux',
    'hpux'          => 'Linux',
    'dec_osf'       => 'Linux',
    'svr4'          => 'Linux',
    'unicos'        => 'Linux',
    'unicosmk'      => 'Linux',
    'ultrix'        => 'Linux',

    'sco_sv'        => 'SCO',
    'sco3'          => 'SCO',
    'sco'           => 'SCO',

    'solaris'       => 'Solaris',
    'sunos'         => 'Solaris',

    'beos'          => 'BeOS',

    # Windows family OSes
    'dos'           => 'Win32',
    'os2'           => 'Win32',
    'mswin32'       => 'Win32',
    'netware'       => 'Win32',
    'cygwin'        => 'Win32',

    # Mac family OSes
    'macos'         => 'Mac',
    'rhapsody'      => 'Mac',
    'darwin'        => 'Mac',

    # Other OSes
    'vms'           => 'Linux',
    'vos'           => 'Linux',
    'os390'         => 'Linux',
    'vmesa'         => 'Linux',
    'riscos'        => 'Linux',
    'amigaos'       => 'Linux',
    'beos'          => 'Linux',
    'machten'       => 'Linux',
    'mpeix'         => 'Linux',
    'bitrig'        => 'Linux',
    'minix'         => 'Linux',
    'nto'           => 'Linux',
);

#----------------------------------------------------------------------------

sub new {
    my ($class) = @_;
    my $self    = {};
    bless  $self, $class;
    return $self;
}

sub get_info {
    my $self  = shift;
    my $data;

    my $plugin = $map{ lc $^O } || 'Linux';

    my $driver = 'Devel::Platform::Info::' . $plugin;
    my $require = "$driver.pm";
    $require =~ s!::!/!g;

    eval {
        require $require;
        $self->{driver} = $driver->new();
        $data = $self->{driver}->get_info();
    };

    $data->{error} = $@ if($@);

    return $data;
}

1;

__END__