From: Steve Hay Date: Thu, 29 Jan 2009 18:05:53 +0000 (+0000) Subject: Upgrade to Win32-0.39. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c9e1d5f9142b619e9cc9f252aa5b68fc13d9627a;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Win32-0.39. --- diff --git a/MANIFEST b/MANIFEST index 7d86fc1..e38c1ae 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1427,6 +1427,7 @@ ext/Win32/t/GetFileVersion.t See if Win32 extension works ext/Win32/t/GetFolderPath.t See if Win32 extension works ext/Win32/t/GetFullPathName.t See if Win32 extension works ext/Win32/t/GetLongPathName.t See if Win32 extension works +ext/Win32/t/GetOSName.t See if Win32 extension works ext/Win32/t/GetOSVersion.t See if Win32 extension works ext/Win32/t/GetShortPathName.t See if Win32 extension works ext/Win32/t/GuidGen.t See if Win32 extension works diff --git a/ext/Win32/Changes b/ext/Win32/Changes index 62077ba..364a902 100644 --- a/ext/Win32/Changes +++ b/ext/Win32/Changes @@ -1,5 +1,12 @@ Revision history for the Perl extension Win32. +0.39 [2009-01-19] + - Add support for Windows 2008 Server and Windows 7 in + Win32::GetOSName() and in the documentation for + Win32::GetOSVersion(). + - Make Win32::GetOSName() implementation testable. + - Document that the OSName for Win32s is actually "WinWin32s". + 0.38 [2008-06-27] - Fix Cygwin releated problems in t/GetCurrentThreadId.t (Jerry D. Hedden). diff --git a/ext/Win32/Win32.pm b/ext/Win32/Win32.pm index 7091783..4015eac 100644 --- a/ext/Win32/Win32.pm +++ b/ext/Win32/Win32.pm @@ -8,7 +8,7 @@ BEGIN { require DynaLoader; @ISA = qw|Exporter DynaLoader|; - $VERSION = '0.38'; + $VERSION = '0.39'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -157,86 +157,62 @@ sub CSIDL_CDBURN_AREA () { 0x003B } # \Local Setti ### This method is just a simple interface into GetOSVersion(). More ### specific or demanding situations should use that instead. -my ($found_os, $found_desc); +my ($cached_os, $cached_desc); sub GetOSName { - my ($os,$desc,$major, $minor, $build, $id)=("",""); - unless (defined $found_os) { - # If we have a run this already, we have the results cached - # If so, return them - - # Use the standard API call to determine the version - ($desc, $major, $minor, $build, $id) = Win32::GetOSVersion(); - - # If id==0 then its a win32s box -- Meaning Win3.11 - unless($id) { - $os = 'Win32s'; - } - else { - # Magic numbers from MSDN documentation of OSVERSIONINFO - # Most version names can be parsed from just the id and minor - # version - $os = { - 1 => { - 0 => "95", - 10 => "98", - 90 => "Me" - }, - 2 => { - 0 => "NT4", - 1 => "XP/.Net", - 2 => "2003", - 51 => "NT3.51" - } - }->{$id}->{$minor}; - } + unless (defined $cached_os) { + my($desc, $major, $minor, $build, $id, undef, undef, undef, $producttype) + = Win32::GetOSVersion(); + ($cached_os, $cached_desc) = _GetOSName($desc, $major, $minor, $build, $id, $producttype); + } + return wantarray ? ($cached_os, $cached_desc) : $cached_os; +} - # This _really_ shouldnt happen. At least not for quite a while - # Politely warn and return undef - unless (defined $os) { - warn qq[Windows version [$id:$major:$minor] unknown!]; - return undef; - } - - my $tag = ""; - - # But distinguising W2k and Vista from NT4 requires looking at the major version - if ($os eq "NT4") { - $os = {5 => "2000", 6 => "Vista"}->{$major} || "NT4"; - } - - # For the rest we take a look at the build numbers and try to deduce - # the exact release name, but we put that in the $desc - elsif ($os eq "95") { - if ($build eq '67109814') { - $tag = '(a)'; - } - elsif ($build eq '67306684') { - $tag = '(b1)'; - } - elsif ($build eq '67109975') { - $tag = '(b2)'; - } - } - elsif ($os eq "98" && $build eq '67766446') { - $tag = '(2nd ed)'; - } - - if (length $tag) { - if (length $desc) { - $desc = "$tag $desc"; - } - else { - $desc = $tag; - } +sub _GetOSName { + my($desc, $major, $minor, $build, $id, $producttype) = @_; + + my($os,$tag); + if ($id == 0) { + $os = "Win32s"; + } + elsif ($id == 1) { + $os = { 0 => "95", 10 => "98", 90 => "Me" }->{$minor}; + } + elsif ($id == 2) { + if ($major == 3) { + $os = "NT3.51"; + } + elsif ($major == 4) { + $os = "NT4"; + } + elsif ($major == 5) { + $os = { 0 => "2000", 1 => "XP/.Net", 2 => "2003" }->{$minor}; + } + elsif ($major == 6) { + $os = { 0 => "Vista", 1 => "7" }->{$minor}; + # 2008 is same as Vista but has "Domaincontroller" or "Server" type + $os = "2008" if $os eq "Vista" && $producttype != 1; } + } + + unless (defined $os) { + warn "Unknown Windows version [$id:$major:$minor]"; + return; + } - # cache the results, so we dont have to do this again - $found_os = "Win$os"; - $found_desc = $desc; + # Take a look at the build numbers and try to deduce + # the exact release name, but we put that in the $desc + if ($os eq "95") { + $tag = { 67109814 => "(a)", 67306684 => "(b1)", "67109975" => "(b2)" }->{$build}; + } + elsif ($os eq "98" && $build eq "67766446") { + $tag = "(2nd ed)"; + } + if ($tag) { + $desc = length($desc) ? "$tag $desc" : $tag; } - return wantarray ? ($found_os, $found_desc) : $found_os; + return ("Win$os", $desc); } # "no warnings 'redefine';" doesn't work for 5.8.7 and earlier @@ -536,7 +512,8 @@ elements are, respectively: An arbitrary descriptive string, the major version number of the operating system, the minor version number, the build number, and a digit indicating the actual operating system. For the ID, the values are 0 for Win32s, 1 for Windows 9X/Me and 2 for -Windows NT/2000/XP/2003/Vista. In scalar context it returns just the ID. +Windows NT/2000/XP/2003/Vista/2008/7. In scalar context it returns just +the ID. Currently known values for ID MAJOR and MINOR are as follows: @@ -551,10 +528,16 @@ Currently known values for ID MAJOR and MINOR are as follows: Windows XP 2 5 1 Windows Server 2003 2 5 2 Windows Vista 2 6 0 + Windows Server 2008 2 6 0 + Windows 7 2 6 1 On Windows NT 4 SP6 and later this function returns the following additional values: SPMAJOR, SPMINOR, SUITEMASK, PRODUCTTYPE. +The version numbers for Windows Vista and Windows Server 2008 are +identical; the PRODUCTTYPE field must be used to differentiate +between them. + SPMAJOR and SPMINOR are are the version numbers of the latest installed service pack. @@ -584,7 +567,10 @@ be one of the following integer values: 1 - Workstation (NT 4, 2000 Pro, XP Home, XP Pro, Vista) 2 - Domaincontroller - 3 - Server + 3 - Server (2000 Server, Server 2003, Server 2008) + +Note that a server that is also a domain controller is reported as +PRODUCTTYPE 2 (Domaincontroller) and not PRODUCTTYPE 3 (Server). =item Win32::GetOSName() @@ -597,7 +583,18 @@ GetOSVersion() in list context. Currently the possible values for the OS name are - Win32s Win95 Win98 WinMe WinNT3.51 WinNT4 Win2000 WinXP/.Net Win2003 WinVista + WinWin32s + Win95 + Win98 + WinMe + WinNT3.51 + WinNT4 + Win2000 + WinXP/.Net + Win2003 + WinVista + Win2008 + Win7 This routine is just a simple interface into GetOSVersion(). More specific or demanding situations should use that instead. Another @@ -610,6 +607,9 @@ backwards compatibility of the Win32 module. Windows .NET Server has been renamed as Windows 2003 Server before final release and uses a different major/minor version number than Windows XP. +Similarly the name "WinWin32s" should have been "Win32s" but has been +kept as-is for backwards compatibility reasons too. + =item Win32::GetShortPathName(PATHNAME) [CORE] Returns a representation of PATHNAME that is composed of short diff --git a/ext/Win32/t/GetOSName.t b/ext/Win32/t/GetOSName.t new file mode 100644 index 0000000..39db36e --- /dev/null +++ b/ext/Win32/t/GetOSName.t @@ -0,0 +1,39 @@ +use strict; +use Test; +use Win32; + +my @tests = ( + # $id, $major, $minor, $pt, $build, $tag + [ "WinWin32s", 0 ], + [ "Win95", 1, 4, 0 ], + [ "Win95", 1, 4, 0, 0, 67109814, "(a)" ], + [ "Win95", 1, 4, 0, 0, 67306684, "(b1)" ], + [ "Win95", 1, 4, 0, 0, 67109975, "(b2)" ], + [ "Win98", 1, 4, 10 ], + [ "Win98", 1, 4, 10, 0, 67766446, "(2nd ed)" ], + [ "WinMe", 1, 4, 90 ], + [ "WinNT3.51", 2, 3, 51 ], + [ "WinNT4", 2, 4, 0 ], + [ "Win2000", 2, 5, 0 ], + [ "WinXP/.Net", 2, 5, 1 ], + [ "Win2003", 2, 5, 2 ], + [ "WinVista", 2, 6, 0, 1 ], + [ "Win2008", 2, 6, 0, 2 ], + [ "Win7", 2, 6, 1 ], +); + +plan tests => 2*scalar(@tests) + 1; + +# Test internal implementation function +for my $test (@tests) { + my($expect, $id, $major, $minor, $pt, $build, $tag) = @$test; + my($os, $desc) = Win32::_GetOSName("", $major, $minor, $build||0, $id, $pt); + ok($os, $expect); + ok($desc, $tag||""); +} + +# Does Win32::GetOSName() return the correct value for the current OS? +my(undef, $major, $minor, $build, $id, undef, undef, undef, $pt) + = Win32::GetOSVersion(); +my($os, $desc) = Win32::_GetOSName("", $major, $minor, $build, $id, $pt); +ok(scalar Win32::GetOSName(), $os);