Skip to content
Browse files

codename and documentation updates

  • Loading branch information...
2 parents c64f147 + b32f0b9 commit 87050e92377fbd3e2905e90e80db5b029a2af932 @barbie committed
View
8 Changes
@@ -1,9 +1,15 @@
Revision history for Perl library Devel-Platform-Info
=====================================================
-0.06 14/07/2010
+0.07 13/01/2011
+ - updated several distribution codenames (Linux & Mac).
+ - documentation update.
+
+0.06 15/07/2010
- added requirement for Test-JSON-Meta-0.08 due to issues with old
versions of JSON not implementing the current API.
+ - better 32/64 detection for BSD (thanks to Chris Williams for help)
+ - upped version check of Test-JSON-Meta to ensure we have JSON v2.
0.05 12/07/2010
- updated Mac version check (Colin Newell).
View
18 META.json
@@ -1,6 +1,6 @@
{
"name": "Devel-Platform-Info",
- "version": "0.06",
+ "version": "0.07",
"abstract": "Unified framework for obtaining common platform metadata.",
"author": [
"Barbie (BARBIE) <barbie@cpan.org>",
@@ -56,35 +56,35 @@
"provides": {
"Devel::Platform::Info": {
"file": "lib/Devel/Platform/Info.pm",
- "version": "0.06"
+ "version": "0.07"
},
"Devel::Platform::Info::BSD": {
"file": "lib/Devel/Platform/Info/BSD.pm",
- "version": "0.06"
+ "version": "0.07"
},
"Devel::Platform::Info::Irix": {
"file": "lib/Devel/Platform/Info/Irix.pm",
- "version": "0.06"
+ "version": "0.07"
},
"Devel::Platform::Info::Linux": {
"file": "lib/Devel/Platform/Info/Linux.pm",
- "version": "0.06"
+ "version": "0.07"
},
"Devel::Platform::Info::Mac": {
"file": "lib/Devel/Platform/Info/Mac.pm",
- "version": "0.06"
+ "version": "0.07"
},
"Devel::Platform::Info::SCO": {
"file": "lib/Devel/Platform/Info/SCO.pm",
- "version": "0.06"
+ "version": "0.07"
},
"Devel::Platform::Info::Solaris": {
"file": "lib/Devel/Platform/Info/Solaris.pm",
- "version": "0.06"
+ "version": "0.07"
},
"Devel::Platform::Info::Win32": {
"file": "lib/Devel/Platform/Info/Win32.pm",
- "version": "0.06"
+ "version": "0.07"
}
},
"no_index": {
View
18 META.yml
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Devel-Platform-Info
-version: 0.06
+version: 0.07
abstract: Unified framework for obtaining common platform metadata
author:
- Barbie (BARBIE) <barbie@cpan.org>
@@ -27,28 +27,28 @@ build_requires:
provides:
Devel::Platform::Info:
file: lib/Devel/Platform/Info.pm
- version: 0.06
+ version: 0.07
Devel::Platform::Info::BSD:
file: lib/Devel/Platform/Info/BSD.pm
- version: 0.06
+ version: 0.07
Devel::Platform::Info::Irix:
file: lib/Devel/Platform/Info/Irix.pm
- version: 0.06
+ version: 0.07
Devel::Platform::Info::Linux:
file: lib/Devel/Platform/Info/Linux.pm
- version: 0.06
+ version: 0.07
Devel::Platform::Info::Mac:
file: lib/Devel/Platform/Info/Mac.pm
- version: 0.06
+ version: 0.07
Devel::Platform::Info::SCO:
file: lib/Devel/Platform/Info/SCO.pm
- version: 0.06
+ version: 0.07
Devel::Platform::Info::Solaris:
file: lib/Devel/Platform/Info/Solaris.pm
- version: 0.06
+ version: 0.07
Devel::Platform::Info::Win32:
file: lib/Devel/Platform/Info/Win32.pm
- version: 0.06
+ version: 0.07
no_index:
directory:
View
35 README
@@ -1,9 +1,10 @@
-Devel::Platform::Info(3) Devel::Platform::Info(3)
+Devel::Platform::Info Devel::Platform::Info(3)
NAME
- Devel::Platform::Info - Retrieve common platform metadata
+ Devel::Platform::Info - Unified framework for obtaining common platform
+ metadata
SYNOPSIS
use Devel::Platform::Info;
@@ -14,6 +15,15 @@ DESCRIPTION
This module is a wrapper to the drivers which can determine platform
metadata regarding the currently running operating system.
+ The intention of this distribution is to provide key identifying compo-
+ nents regarding the platform currently being used, for the CPAN Testers
+ test reports. Currently the reports do not often contain enough infor-
+ mation to help authors understand specific failures, where the platform
+ may be a factor.
+
+ However, it is hoped that this distribution will find more uses far
+ beyond the usage for CPAN Testers.
+
INTERFACE
The Constructor
@@ -38,8 +48,17 @@ INTERFACE
is64bit
osflag
- Note that the 'source' key returns the commands and output used
- to obtain the metadata for possible future use.
+ Note that the 'source' key returns the commands and output used to
+ obtain the metadata for possible future use.
+
+ Further keys may be available to provide additional information if
+ applicable to the specific operating system.
+
+REFERENCES
+ The following links were used to understand how to retrieve the meta-
+ data:
+
+ * http://alma.ch/perl/perloses.htm
BUGS, PATCHES & FIXES
There are no known bugs at the time of this release. However, if you
@@ -47,21 +66,21 @@ BUGS, PATCHES & FIXES
within the POD documentation, please send bug reports and patches to
the RT Queue (see below).
- RT Queue - http://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Plat-
+ RT Queue: http://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Plat-
form-Info
AUTHORS
Barbie (BARBIE) <barbie@cpan.org>
Brian McCauley (NOBULL) <nobull67@gmail.com>
Colin Newell http://colinnewell.wordpress.com/
- Jon ’JJ’ Allen (JONALLEN) <jj@jonallen.info>
+ Jon 'JJ' Allen (JONALLEN) <jj@jonallen.info>
COPYRIGHT & LICENSE
- Copyright (C) 2010 Birmingham Perl Mongers
+ Copyright (C) 2010-2011 Birmingham Perl Mongers
This module is free software; you can redistribute it and/or
modify it under the Artistic License 2.0.
-perl v5.8.8 2010-06-25 Devel::Platform::Info(3)
+perl v5.8.8 2011-01-13 Devel::Platform::Info(3)
View
10 lib/Devel/Platform/Info.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use vars qw($VERSION);
-$VERSION = '0.06';
+$VERSION = '0.07';
#----------------------------------------------------------------------------
@@ -105,7 +105,7 @@ This module is a wrapper to the drivers which can determine platform metadata
regarding the currently running operating system.
The intention of this distribution is to provide key identifying components
-regarding the platform currently being used, for the CPAN Testers test
+regarding the platform currently being used, for the CPAN Testers test
reports. Currently the reports do not often contain enough information to help
authors understand specific failures, where the platform may be a factor.
@@ -143,10 +143,10 @@ Returns at least the following keys:
is64bit
osflag
-Note that the 'source' key returns the commands and output used to obtain the
+Note that the 'source' key returns the commands and output used to obtain the
metadata for possible future use.
-Further keys maybe available to provide additional information if applicable
+Further keys may be available to provide additional information if applicable
to the specific operating system.
=back
@@ -174,7 +174,7 @@ RT Queue: http://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Platform-Info
=head1 COPYRIGHT & LICENSE
- Copyright (C) 2010 Birmingham Perl Mongers
+ Copyright (C) 2010-2011 Birmingham Perl Mongers
This module is free software; you can redistribute it and/or
modify it under the Artistic License 2.0.
View
17 lib/Devel/Platform/Info/BSD.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use vars qw($VERSION);
-$VERSION = '0.06';
+$VERSION = '0.07';
#----------------------------------------------------------------------------
@@ -43,8 +43,12 @@ sub get_info {
$self->{info}{oslabel} = $self->{info}{kname};
$self->{info}{osvers} = $self->{info}{kvers};
$self->{info}{osvers} =~ s/-release.*//;
- $self->{info}{is32bit} = $self->{info}{kname} !~ /64/ ? 1 : 0;
- $self->{info}{is64bit} = $self->{info}{kname} =~ /64/ ? 1 : 0;
+ $self->{info}{is32bit} = $self->{info}{archname} !~ /(64|alpha)/ ? 1 : 0;
+ $self->{info}{is64bit} = $self->{info}{archname} =~ /(64|alpha)/ ? 1 : 0;
+
+ # NOTE: 'sparc64' (64bit) and 'sparc' (32bit) both look like they identify
+ # themselves as archname = 'sparc'. If true, is there any other way to
+ # easily distinguish the difference?
$self->{info}{source}{$commands{$_}} = $self->{cmds}{$_} for(keys %commands);
return $self->{info};
@@ -69,7 +73,7 @@ Devel::Platform::Info::BSD - Retrieve BSD platform metadata
=head1 DESCRIPTION
This module is a driver to determine platform metadata regarding the BSD
-operating system. It should be called indirectly via it's parent
+family of operating systems. It should be called indirectly via it's parent
Devel::Platform::Info
=head1 INTERFACE
@@ -114,6 +118,9 @@ Returns the following keys:
The following links were used to understand how to retrieve the metadata:
* http://nixcraft.com/all-about-freebsd-openbsd-netbsd/234-freebsd-how-find-out-kernel-version.html
+ * http://www.netbsd.org/ports/
+
+Thanks to Chris 'BINGOS' Williams for the pointers to the appropriate links.
=head1 BUGS, PATCHES & FIXES
@@ -132,7 +139,7 @@ RT Queue: http://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Platform-Info
=head1 COPYRIGHT & LICENSE
- Copyright (C) 2010 Birmingham Perl Mongers
+ Copyright (C) 2010-2011 Birmingham Perl Mongers
This module is free software; you can redistribute it and/or
modify it under the Artistic License 2.0.
View
6 lib/Devel/Platform/Info/Irix.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use vars qw($VERSION);
-$VERSION = '0.06';
+$VERSION = '0.07';
#----------------------------------------------------------------------------
@@ -70,7 +70,7 @@ Devel::Platform::Info::Irix - Retrieve Irix platform metadata
=head1 DESCRIPTION
This module is a driver to determine platform metadata regarding the Irix
-operating system. It should be called indirectly via it's parent
+operating system. It should be called indirectly via it's parent
Devel::Platform::Info
=head1 INTERFACE
@@ -133,7 +133,7 @@ RT Queue: http://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Platform-Info
=head1 COPYRIGHT & LICENSE
- Copyright (C) 2010 Birmingham Perl Mongers
+ Copyright (C) 2010-2011 Birmingham Perl Mongers
This module is free software; you can redistribute it and/or
modify it under the Artistic License 2.0.
View
163 lib/Devel/Platform/Info/Linux.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use vars qw($VERSION);
-$VERSION = '0.06';
+$VERSION = '0.07';
#----------------------------------------------------------------------------
@@ -22,95 +22,100 @@ my %commands = (
my %default = ();
my %archlinux = (
- '0.1' => 'Homer',
- '0.2' => 'Vega',
- '0.3' => 'Firefly',
- '0.4' => 'Dragon',
- '0.5' => 'Nova',
- '0.6' => 'Widget',
- '0.7' => 'Wombat',
- '0.8' => 'Voodoo',
- '2007.05' => 'Duke',
- '2007.08' => "Don't Panic",
- '2008.06' => 'Overlord',
- '2009.02' => '2009.02',
- '2009.08' => '2009.08',
- '2010.05' => '2010.05',
+ '0.1' => 'Homer',
+ '0.2' => 'Vega',
+ '0.3' => 'Firefly',
+ '0.4' => 'Dragon',
+ '0.5' => 'Nova',
+ '0.6' => 'Widget',
+ '0.7' => 'Wombat',
+ '0.8' => 'Voodoo',
+ '2007.05' => 'Duke',
+ '2007.08' => "Don't Panic",
+ '2008.06' => 'Overlord',
+ '2009.02' => '2009.02',
+ '2009.08' => '2009.08',
+ '2010.05' => '2010.05',
);
my %debian = (
- '1.1' => 'buzz',
- '1.2' => 'rex',
- '1.3' => 'bo',
- '2.0' => 'hamm',
- '2.1' => 'slink',
- '2.2' => 'potato',
- '3.0' => 'woody',
- '3.1' => 'sarge',
- '4.0' => 'etch',
- '5.0' => 'lenny',
- '6.0' => 'squeeze',
+ '1.1' => 'buzz',
+ '1.2' => 'rex',
+ '1.3' => 'bo',
+ '2.0' => 'hamm',
+ '2.1' => 'slink',
+ '2.2' => 'potato',
+ '3.0' => 'woody',
+ '3.1' => 'sarge',
+ '4.0' => 'etch',
+ '5.0' => 'lenny',
+ '6.0' => 'squeeze',
+ '7.0' => 'wheezy',
);
my %fedora = (
- '1' => 'Yarrow',
- '2' => 'Tettnang',
- '3' => 'Heidelberg',
- '4' => 'Stentz',
- '5' => 'Bordeaux',
- '6' => 'Zod',
- '7' => 'Moonshine',
- '8' => 'Werewolf',
- '9' => 'Sulphur',
- '10' => 'Cambridge',
- '11' => 'Leonidas',
- '12' => 'Constantine',
- '13' => 'Goddard',
- '14' => 'Laughlin',
+ '1' => 'Yarrow',
+ '2' => 'Tettnang',
+ '3' => 'Heidelberg',
+ '4' => 'Stentz',
+ '5' => 'Bordeaux',
+ '6' => 'Zod',
+ '7' => 'Moonshine',
+ '8' => 'Werewolf',
+ '9' => 'Sulphur',
+ '10' => 'Cambridge',
+ '11' => 'Leonidas',
+ '12' => 'Constantine',
+ '13' => 'Goddard',
+ '14' => 'Laughlin',
);
my %mandriva = (
- '5.1' => 'Venice',
- '5.2' => 'Leeloo',
- '5.3' => 'Festen',
- '6.0' => 'Venus',
- '6.1' => 'Helios',
- '7.0' => 'Air',
- '7.1' => 'Helium',
- '7.2' => 'Odyssey (called Ulysses during beta)',
- '8.0' => 'Traktopel',
- '8.1' => 'Vitamin',
- '8.2' => 'Bluebird',
- '9.0' => 'Dolphin',
- '9.1' => 'Bamboo',
- '9.2' => 'FiveStar',
- '10.0' => 'Community and Official',
- '10.1' => 'Community',
- '10.1' => 'Official',
- '10.2' => 'Limited Edition 2005',
- '2006.0' => 'Mandriva Linux 2006',
- '2007' => 'Mandriva Linux 2007',
- '2007.1' => 'Mandriva Linux 2007 Spring',
- '2008.0' => 'Mandriva Linux 2008',
- '2008.1' => 'Mandriva Linux 2008 Spring',
- '2009.0' => 'Mandriva Linux 2009',
- '2009.1' => 'Mandriva Linux 2009 Spring',
- '2010.0' => 'Mandriva Linux 2010 (Adélie)',
+ '5.1' => 'Venice',
+ '5.2' => 'Leeloo',
+ '5.3' => 'Festen',
+ '6.0' => 'Venus',
+ '6.1' => 'Helios',
+ '7.0' => 'Air',
+ '7.1' => 'Helium',
+ '7.2' => 'Odyssey (called Ulysses during beta)',
+ '8.0' => 'Traktopel',
+ '8.1' => 'Vitamin',
+ '8.2' => 'Bluebird',
+ '9.0' => 'Dolphin',
+ '9.1' => 'Bamboo',
+ '9.2' => 'FiveStar',
+ '10.0' => 'Community and Official',
+ '10.1' => 'Community',
+ '10.1' => 'Official',
+ '10.2' => 'Limited Edition 2005',
+ '2006.0' => 'Mandriva Linux 2006',
+ '2007' => 'Mandriva Linux 2007',
+ '2007.1' => 'Mandriva Linux 2007 Spring',
+ '2008.0' => 'Mandriva Linux 2008',
+ '2008.1' => 'Mandriva Linux 2008 Spring',
+ '2009.0' => 'Mandriva Linux 2009',
+ '2009.1' => 'Mandriva Linux 2009 Spring',
+ '2010.0' => 'Mandriva Linux 2010 (Adélie)',
+ '2010.1' => 'Mandriva Linux 2010 Spring',
+ '2010.2' => 'Mandriva Linux 2010.2',
);
my %ubuntu = (
- '4.10' => 'Warty Warthog',
- '5.04' => 'Hoary Hedgehog',
- '5.10' => 'Breezy Badger',
- '6.06' => 'Dapper Drake',
- '6.10' => 'Edgy Eft',
- '7.04' => 'Feisty Fawn',
- '7.10' => 'Gutsy Gibbon',
- '8.04' => 'Hardy Heron',
- '8.10' => 'Intrepid Ibex',
- '9.04' => 'Jaunty Jackalope',
- '9.10' => 'Karmic Koala',
- '10.04' => 'Lucid Lynx',
+ '4.10' => 'Warty Warthog',
+ '5.04' => 'Hoary Hedgehog',
+ '5.10' => 'Breezy Badger',
+ '6.06' => 'Dapper Drake',
+ '6.10' => 'Edgy Eft',
+ '7.04' => 'Feisty Fawn',
+ '7.10' => 'Gutsy Gibbon',
+ '8.04' => 'Hardy Heron',
+ '8.10' => 'Intrepid Ibex',
+ '9.04' => 'Jaunty Jackalope',
+ '9.10' => 'Karmic Koala',
+ '10.04' => 'Lucid Lynx',
+ '10.10' => 'Maverick Meerkat',
+ '11.04' => 'Natty Narwhal',
);
my %distributions = (
@@ -339,7 +344,7 @@ RT Queue: http://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Platform-Info
=head1 COPYRIGHT & LICENSE
- Copyright (C) 2010 Birmingham Perl Mongers
+ Copyright (C) 2010-2011 Birmingham Perl Mongers
This module is free software; you can redistribute it and/or
modify it under the Artistic License 2.0.
View
27 lib/Devel/Platform/Info/Mac.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use vars qw($VERSION);
-$VERSION = '0.06';
+$VERSION = '0.07';
#-------------------------------------------------------------------------------
@@ -22,11 +22,11 @@ sub get_info {
my $self = shift;
$self->{info}{osname} = 'Mac';
$self->{info}{osflag} = $^O;
-
+
my $uname_s = $self->_command('uname -s');
if ($uname_s =~ /Darwin/i) {
$self->{info}{oslabel} = 'OS X';
-
+
my $productversion = $self->_command('sw_vers -productVersion');
if ($productversion =~ /((\d+)\.(\d+)(\.(\d+))?)/) {
my ($version, $major, $minor) = ($1, $2, $3);
@@ -37,21 +37,21 @@ sub get_info {
}
}
}
-
+
if (my $arch = $self->_command('uname -p')) {
chomp $arch;
$self->{info}{archname} = $arch;
$self->{info}{is32bit} = $arch !~ /_(64)$/ ? 1 : 0;
$self->{info}{is64bit} = $arch =~ /_(64)$/ ? 1 : 0;
}
-
+
if (my $unamev = $self->_command('uname -v')) {
chomp $unamev;
$self->{info}{kernel} = $unamev;
}
-
+
$self->_command('uname -a');
-
+
return $self->{info};
}
@@ -62,11 +62,11 @@ sub _command {
my $self = shift;
my $command = shift;
my $result = `$command`;
-
- $self->{info}{source}{$command} = $result;
-
+
+ $self->{info}{source}{$command} = $result;
+
chomp $result;
- return $result;
+ return $result;
}
#-------------------------------------------------------------------------------
@@ -80,6 +80,7 @@ sub _macos_versions {
'10.4' => 'Tiger',
'10.5' => 'Leopard',
'10.6' => 'Snow Leopard',
+ '10.7' => 'Lion',
};
}
@@ -102,7 +103,7 @@ Devel::Platform::Info::Mac - Retrieve Mac platform metadata
=head1 DESCRIPTION
This module is a driver to determine platform metadata regarding the Mac
-operating system. It should be called indirectly via it's parent
+operating system. It should be called indirectly via it's parent
Devel::Platform::Info
=head1 INTERFACE
@@ -156,7 +157,7 @@ RT Queue: http://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Platform-Info
=head1 COPYRIGHT & LICENSE
- Copyright (C) 2010 Birmingham Perl Mongers
+ Copyright (C) 2010-2011 Birmingham Perl Mongers
This module is free software; you can redistribute it and/or
modify it under the Artistic License 2.0.
View
6 lib/Devel/Platform/Info/SCO.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use vars qw($VERSION);
-$VERSION = '0.06';
+$VERSION = '0.07';
#----------------------------------------------------------------------------
@@ -84,7 +84,7 @@ Devel::Platform::Info::SCO - Retrieve SCO Unix platform metadata
=head1 DESCRIPTION
This module is a driver to determine platform metadata regarding the SCO
-operating system. It should be called indirectly via it's parent
+operating system. It should be called indirectly via it's parent
Devel::Platform::Info
=head1 INTERFACE
@@ -142,7 +142,7 @@ RT Queue: http://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Platform-Info
=head1 COPYRIGHT & LICENSE
- Copyright (C) 2010 Birmingham Perl Mongers
+ Copyright (C) 2010-2011 Birmingham Perl Mongers
This module is free software; you can redistribute it and/or
modify it under the Artistic License 2.0.
View
6 lib/Devel/Platform/Info/Solaris.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use vars qw($VERSION);
-$VERSION = '0.06';
+$VERSION = '0.07';
#----------------------------------------------------------------------------
@@ -73,7 +73,7 @@ Devel::Platform::Info::Solaris - Retrieve Solaris platform metadata
=head1 DESCRIPTION
This module is a driver to determine platform metadata regarding the Solaris
-operating system. It should be called indirectly via it's parent
+operating system. It should be called indirectly via it's parent
Devel::Platform::Info
=head1 INTERFACE
@@ -138,7 +138,7 @@ RT Queue: http://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Platform-Info
=head1 COPYRIGHT & LICENSE
- Copyright (C) 2010 Birmingham Perl Mongers
+ Copyright (C) 2010-2011 Birmingham Perl Mongers
This module is free software; you can redistribute it and/or
modify it under the Artistic License 2.0.
View
212 lib/Devel/Platform/Info/Win32.pm
@@ -5,7 +5,7 @@ use warnings;
use POSIX;
use vars qw($VERSION);
-$VERSION = '0.06';
+$VERSION = '0.07';
#----------------------------------------------------------------------------
@@ -18,117 +18,117 @@ sub new {
}
sub get_info {
- my $self = shift;
-
- $self->{info}{osflag} = $^O;
- my $inf = $self->_GetArchName();
- $self->{info}{oslabel} = $inf->{osLabel};
- $self->{info}{osvers} = $inf->{version};
- $self->{info}{archname} = $inf->{archname};
- $self->{info}{is32bit} = $self->{info}{archname} !~ /64/ ? 1 : 0;
- $self->{info}{is64bit} = $self->{info}{archname} =~ /64/ ? 1 : 0;
- $self->{info}{source} = $inf->{source};
- $self->{info}{wow64} = $inf->{wow64};
-
- return $self->{info};
+ my $self = shift;
+
+ $self->{info}{osflag} = $^O;
+ my $inf = $self->_GetArchName();
+ $self->{info}{oslabel} = $inf->{osLabel};
+ $self->{info}{osvers} = $inf->{version};
+ $self->{info}{archname} = $inf->{archname};
+ $self->{info}{is32bit} = $self->{info}{archname} !~ /64/ ? 1 : 0;
+ $self->{info}{is64bit} = $self->{info}{archname} =~ /64/ ? 1 : 0;
+ $self->{info}{source} = $inf->{source};
+ $self->{info}{wow64} = $inf->{wow64};
+
+ return $self->{info};
}
sub _GetArchName
{
- my $self = shift;
+ my $self = shift;
my @uname = POSIX::uname();
- my @versions = Win32::GetOSVersion();
+ my @versions = Win32::GetOSVersion();
my $info = $self->_InterpretWin32Info(@versions);
$self->_AddPOSIXInfo($info, \@uname);
- return $info;
+ return $info;
}
sub _AddPOSIXInfo
{
- my $self = shift;
- my $info = shift;
- my $uname = shift;
- my $arch = $uname->[4];
- $info->{archname} = $arch;
- $info->{source} = {
- uname => $uname,
- GetOSVersion => $info->{source},
- };
- # used the tip from David Wang's blog,
- # http://blogs.msdn.com/b/david.wang/archive/2006/03/26/howto-detect-process-bitness.aspx
- if($ENV{'PROCESSOR_ARCHITEW6432'})
- {
- $info->{wow64} = 1;
- }
- else
- {
- $info->{wow64} = 0;
- }
+ my $self = shift;
+ my $info = shift;
+ my $uname = shift;
+ my $arch = $uname->[4];
+ $info->{archname} = $arch;
+ $info->{source} = {
+ uname => $uname,
+ GetOSVersion => $info->{source},
+ };
+ # used the tip from David Wang's blog,
+ # http://blogs.msdn.com/b/david.wang/archive/2006/03/26/howto-detect-process-bitness.aspx
+ if($ENV{'PROCESSOR_ARCHITEW6432'})
+ {
+ $info->{wow64} = 1;
+ }
+ else
+ {
+ $info->{wow64} = 0;
+ }
}
sub _InterpretWin32Info
{
- my $self = shift;
- my @versionInfo = @_;
- my ($string, $major, $minor, $build, $id, $spmajor, $spminor, $suitemask, $producttype, @extra) = @versionInfo;
- my ($osname, $oslabel, $version, $source);
- my %info;
- my $NTWORKSTATION = 1;
- if($major == 5 && $minor == 2 && $producttype == $NTWORKSTATION)
- {
- $osname = 'Windows XP Pro 64';
- } elsif($major == 5 && $minor == 2 && $producttype != $NTWORKSTATION)
- {
- # server 2003, win home server
- # server 2003 R2
- # I need more info from GetSystemMetrics
- # be sure about the exact details.
- $osname = 'Windows Server 2003';
- } elsif($major == 5 && $minor == 1)
- {
- $osname = 'Windows XP';
- } elsif($major == 5 && $minor == 0)
- {
- $osname = 'Windows 2000';
- } elsif($major == 6 && $minor == 1 && $producttype == $NTWORKSTATION)
- {
- $osname = 'Windows 7';
- } elsif($major == 6 && $minor == 1 && $producttype != $NTWORKSTATION)
- {
- $osname = 'Windows Server 2008 R2';
- } elsif($major == 6 && $minor == 0 && $producttype == $NTWORKSTATION)
- {
- $osname = 'Windows Vista';
- } elsif($major == 6 && $minor == 0 && $producttype != $NTWORKSTATION)
- {
- $osname = 'Windows Server 2008';
- } elsif($major == 4 && $minor == 0 && $id == 1)
- {
- $osname = "Windows 95";
- } elsif($major == 4 && $minor == 10)
- {
- $osname = "Windows 98";
- } elsif($major == 4 && $minor == 90)
- {
- $osname = "Windows Me";
- } elsif($major == 4 && $minor == 0)
- {
- $osname = 'Windows NT 4';
- } elsif($major == 3 && $minor == 51)
- {
- $osname = "Windows NT 3.51";
- } else
- {
- $osname = 'Unrecognised - please file an RT case';
- }
- my $info =
- {
- osName => 'Windows',
- osLabel => $osname,
- version => "$major.$minor.$build.$id",
- source => \@versionInfo,
- };
- return $info;
+ my $self = shift;
+ my @versionInfo = @_;
+ my ($string, $major, $minor, $build, $id, $spmajor, $spminor, $suitemask, $producttype, @extra) = @versionInfo;
+ my ($osname, $oslabel, $version, $source);
+ my %info;
+ my $NTWORKSTATION = 1;
+ if($major == 5 && $minor == 2 && $producttype == $NTWORKSTATION)
+ {
+ $osname = 'Windows XP Pro 64';
+ } elsif($major == 5 && $minor == 2 && $producttype != $NTWORKSTATION)
+ {
+ # server 2003, win home server
+ # server 2003 R2
+ # I need more info from GetSystemMetrics
+ # be sure about the exact details.
+ $osname = 'Windows Server 2003';
+ } elsif($major == 5 && $minor == 1)
+ {
+ $osname = 'Windows XP';
+ } elsif($major == 5 && $minor == 0)
+ {
+ $osname = 'Windows 2000';
+ } elsif($major == 6 && $minor == 1 && $producttype == $NTWORKSTATION)
+ {
+ $osname = 'Windows 7';
+ } elsif($major == 6 && $minor == 1 && $producttype != $NTWORKSTATION)
+ {
+ $osname = 'Windows Server 2008 R2';
+ } elsif($major == 6 && $minor == 0 && $producttype == $NTWORKSTATION)
+ {
+ $osname = 'Windows Vista';
+ } elsif($major == 6 && $minor == 0 && $producttype != $NTWORKSTATION)
+ {
+ $osname = 'Windows Server 2008';
+ } elsif($major == 4 && $minor == 0 && $id == 1)
+ {
+ $osname = "Windows 95";
+ } elsif($major == 4 && $minor == 10)
+ {
+ $osname = "Windows 98";
+ } elsif($major == 4 && $minor == 90)
+ {
+ $osname = "Windows Me";
+ } elsif($major == 4 && $minor == 0)
+ {
+ $osname = 'Windows NT 4';
+ } elsif($major == 3 && $minor == 51)
+ {
+ $osname = "Windows NT 3.51";
+ } else
+ {
+ $osname = 'Unrecognised - please file an RT case';
+ }
+ my $info =
+ {
+ osName => 'Windows',
+ osLabel => $osname,
+ version => "$major.$minor.$build.$id",
+ source => \@versionInfo,
+ };
+ return $info;
}
@@ -149,7 +149,7 @@ Devel::Platform::Info::Win32 - Retrieve Windows platform metadata
=head1 DESCRIPTION
This module is a driver to determine platform metadata regarding the Win32
-operating system. It should be called indirectly via it's parent
+operating system. It should be called indirectly via it's parent
Devel::Platform::Info
=head1 INTERFACE
@@ -184,23 +184,23 @@ Returns the following keys:
osflag
wow64
-On a 64 bit Windows if you are running 32 bit perl the archname is likely to
-indicate x86. The wow64 variable will tell you if you are in fact running on
+On a 64 bit Windows if you are running 32 bit perl the archname is likely to
+indicate x86. The wow64 variable will tell you if you are in fact running on
x64 Windows.
=back
=head1 BUGS, PATCHES & FIXES
-The module cannot accurately tell the difference between the Windows Server
+The module cannot accurately tell the difference between the Windows Server
2003 and Windows Server 2003 R2.
-The wow64 variable indicates whether or not you are running a 32 bit perl on a
-64 bit windows. It uses the environment variable PROCESSOR_ARCHITEW6432 rather
+The wow64 variable indicates whether or not you are running a 32 bit perl on a
+64 bit windows. It uses the environment variable PROCESSOR_ARCHITEW6432 rather
than the IsWow64Process call because it's simpler.
-If you spot a bug or are experiencing difficulties, that is not explained
-within the POD documentation, please send bug reports and patches to the RT
+If you spot a bug or are experiencing difficulties, that is not explained
+within the POD documentation, please send bug reports and patches to the RT
Queue (see below).
RT Queue: http://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Platform-Info
@@ -214,7 +214,7 @@ RT Queue: http://rt.cpan.org/Public/Dist/Display.html?Name=Devel-Platform-Info
=head1 COPYRIGHT & LICENSE
- Copyright (C) 2010 Birmingham Perl Mongers
+ Copyright (C) 2010-2011 Birmingham Perl Mongers
This module is free software; you can redistribute it and/or
modify it under the Artistic License 2.0.

0 comments on commit 87050e9

Please sign in to comment.
Something went wrong with that request. Please try again.