Upgrade to Win32-0.39.

diff --git a/MANIFEST b/MANIFEST
index 7d86fc1..e38c1ae 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 }     # <user name>\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 (file)
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);