Update Win32 from CPAN (from 0.40 to 0.41)

5 files changed, 65 insertions, 24 deletions

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 239dbdea7a..d6d87a2abb 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -1588,7 +1588,7 @@ use File::Glob qw(:case);
     'Win32' =>
 	{
 	'MAINTAINER'	=> 'jand',
-	'DISTRIBUTION'	=> "JDB/Win32-0.40.tar.gz",
+	'DISTRIBUTION'	=> "JDB/Win32-0.41.tar.gz",
 	'FILES'		=> q[cpan/Win32],
 	'UPSTREAM'	=> 'cpan',
 	},
diff --git a/cpan/Win32/Changes b/cpan/Win32/Changes
index 7dd898662c..24235aadbf 100644
--- a/cpan/Win32/Changes
+++ b/cpan/Win32/Changes
@@ -1,17 +1,31 @@
 Revision history for the Perl extension Win32.

 

+0.41	[2010-12-10]

+	- Fix Win32::GetChipName() to return the native processor type when

+	  running 32-bit Perl on 64-bit Windows (WOW64).  This will also

+	  affect the values returned by Win32::GetOSDisplayName() and

+	  Win32::GetOSName(). [rt#63797]

+	- Fix Win32::GetOSDisplayName() to return the correct values for

+	  all products even when a service pack has been installed. (This

+	  was only an issue for some "special" editions).

+	- The display name for "Windows 7 Business Edition" is actually

+	  "Windows 7 Professional".

+	- Fix t/GetOSName.t tests to avoid using the values returned by

+	  GetSystemMetrics() when the test template didn't specify any

+	  value at all.

+

 0.40	[2010-12-08]

 	- Add Win32::GetSystemMetrics function.

 	- Add Win32::GetProductInfo() function.

 	- Add Win32::GetOSDisplayName() function.

 	- Detect "Windows Server 2008 R2" as "Win2008" in Win32::GetOSName()

-	  (used to return "Win7" before).

+	  (used to return "Win7" before). [rt#57172]

 	- Detect "Windows Home Server" as "WinHomeSvr" in Win32::GetOSName()

 	  (used to return "Win2003" before).

-	- Added "R2", "Media Center", "Tablet PC", "Starter Edition" etc.

+	- Add "R2", "Media Center", "Tablet PC", "Starter Edition" etc.

 	  tags to the description returned by Win32::GetOSName() in

 	  list context.

-	- Rewrote the t/GetOSName.t tests

+	- Rewrite the t/GetOSName.t tests

 

 0.39	[2009-01-19]

 	- Add support for Windows 2008 Server and Windows 7 in

diff --git a/cpan/Win32/Win32.pm b/cpan/Win32/Win32.pm
index cef62717d0..d2eb1ad895 100644
--- a/cpan/Win32/Win32.pm
+++ b/cpan/Win32/Win32.pm
@@ -8,7 +8,7 @@ package Win32;
     require DynaLoader;

 

     @ISA = qw|Exporter DynaLoader|;

-    $VERSION = '0.40';

+    $VERSION = '0.41';

     $XS_VERSION = $VERSION;

     $VERSION = eval $VERSION;

 

@@ -275,11 +275,12 @@ sub GetOSDisplayName {
     # Calling GetOSDisplayName() with arguments is for the test suite only!

     my($name,$desc) = @_ ? @_ : GetOSName();

     $name =~ s/^Win//;

-    if ($desc eq "Windows Home Server" || $desc eq "Windows XP Professional x64 Edition") {

+    if ($desc =~ /^Windows Home Server\b/ || $desc =~ /^Windows XP Professional x64 Edition\b/) {

 	($name, $desc) = ($desc, "");

     }

-    elsif ($desc =~ s/\s*(Windows (.*) Server( \d+)?)$//) {

-       ($name, $desc) = ("$1 $name", $desc);

+    elsif ($desc =~ s/\s*(Windows (.*) Server( \d+)?)//) {

+	$name = "$1 $name";

+	$desc =~ s/^\s+//;

     }

     else {

 	for ($name) {

@@ -300,9 +301,10 @@ sub GetOSDisplayName {
 

 sub _GetSystemMetrics {

     my($index,$metrics) = @_;

+    return Win32::GetSystemMetrics($index) unless ref $metrics;

     return $metrics->{$index} if ref $metrics eq "HASH" && defined $metrics->{$index};

     return 1 if ref $metrics eq "ARRAY" && grep $_ == $index, @$metrics;

-    return Win32::GetSystemMetrics($index);

+    return 0;

 }

 

 sub _GetOSName {

@@ -472,7 +474,8 @@ sub _GetOSName {
                $desc .= " Enterprise";

             }

             elsif ($productinfo == PRODUCT_BUSINESS) {

-               $desc .= " Business";

+	       # "Windows 7 Business" had a name change to "Windows 7 Professional"

+               $desc .= $minor == 0 ? " Business" : "Professional";

             }

             elsif ($productinfo == PRODUCT_STARTER) {

                $desc .= " Starter";

@@ -704,8 +707,10 @@ $ENV{PROCESSOR_ARCHITECTURE}.  This might not work on Win9X.
 

 =item Win32::GetChipName()

 

-Returns the processor type: 386, 486 or 586 for x86 processors,

-8664 for the x64 processor and 2200 for the Itanium.

+Returns the processor type: 386, 486 or 586 for x86 processors, 8664

+for the x64 processor and 2200 for the Itanium.  Since it returns the

+native processor type it will return a 64-bit processor type even when

+called from a 32-bit Perl running on 64-bit Windows.

 

 =item Win32::GetCwd()

 

@@ -856,6 +861,10 @@ being used.  It returns names like these (random samples):
    Windows Vista Ultimate (32-bit)

    Windows Small Business Server 2008 R2 (64-bit)

 

+The display name describes the native Windows version, so even on a

+32-bit Perl this function may return a "Windows ... (64-bit)" name

+when running on a 64-bit Windows.

+

 This function should only be used to display the actual OS name to the

 user; it should not be used to determine the class of operating systems

 this system belongs to.  The Win32::GetOSName(), Win32::GetOSVersion,

diff --git a/cpan/Win32/Win32.xs b/cpan/Win32/Win32.xs
index 2799290597..f6d96b4374 100644
--- a/cpan/Win32/Win32.xs
+++ b/cpan/Win32/Win32.xs
@@ -39,6 +39,7 @@ typedef BOOL (__stdcall *PFNEqualSid)(PSID, PSID);
 typedef void* (__stdcall *PFNFreeSid)(PSID);

 typedef BOOL (__stdcall *PFNIsUserAnAdmin)(void);

 typedef BOOL (WINAPI *PFNGetProductInfo)(DWORD, DWORD, DWORD, DWORD, DWORD*);

+typedef void (WINAPI *PFNGetNativeSystemInfo)(LPSYSTEM_INFO lpSystemInfo);

 

 #ifndef CSIDL_MYMUSIC

 #   define CSIDL_MYMUSIC              0x000D

@@ -792,9 +793,17 @@ XS(w32_GetChipName)
 {

     dXSARGS;

     SYSTEM_INFO sysinfo;

+    HMODULE module;

+    PFNGetNativeSystemInfo pfnGetNativeSystemInfo;

 

     Zero(&sysinfo,1,SYSTEM_INFO);

-    GetSystemInfo(&sysinfo);

+    module = GetModuleHandle("kernel32.dll");

+    GETPROC(GetNativeSystemInfo);

+    if (pfnGetNativeSystemInfo)

+        pfnGetNativeSystemInfo(&sysinfo);

+    else

+        GetSystemInfo(&sysinfo);

+

     /* XXX docs say dwProcessorType is deprecated on NT */

     XSRETURN_IV(sysinfo.dwProcessorType);

 }

@@ -1659,7 +1668,7 @@ XS(w32_GetSystemMetrics)
     if (items != 1)

 	Perl_croak(aTHX_ "usage: Win32::GetSystemMetrics($index)");

 

-    XSRETURN_IV(GetSystemMetrics(SvIV(ST(0))));

+    XSRETURN_IV(GetSystemMetrics((int)SvIV(ST(0))));

 }

 

 XS(w32_GetProductInfo)

diff --git a/cpan/Win32/t/GetOSName.t b/cpan/Win32/t/GetOSName.t
index 8c29d30359..32a43df70e 100644
--- a/cpan/Win32/t/GetOSName.t
+++ b/cpan/Win32/t/GetOSName.t
@@ -11,7 +11,7 @@ use Win32;
 # The "display name" value is the same as the $pretty field,

 # prefixed by "Windows ", with all "[]{}" characters removed.

 

-# $pretty, $os $id, $major, $minor, $sm, $pt, $metric, $tag

+# $pretty, $os $id, $major, $minor, $sm, $pt, $metric

 

 my @intel_tests = (

 ["Win32s",                          "Win32s",  0                     ],

@@ -94,6 +94,7 @@ my @dual_tests = (
 ["7 [Starter]",                     "7",       2, 6, 1, 0x0b         ],

 ["7 [Home Basic]",                  "7",       2, 6, 1, 0x02         ],

 ["7 [Home Premium]",                "7",       2, 6, 1, 0x03         ],

+["7 [Professional]",                "7",       2, 6, 1, 0x06         ],

 ["7 [Professional]",                "7",       2, 6, 1, 0x30         ],

 ["7 [Enterprise]",                  "7",       2, 6, 1, 0x04         ],

 ["7 [Ultimate]",                    "7",       2, 6, 1, 0x01         ],

@@ -109,20 +110,18 @@ my @ia64_tests = (
 ["2003 [Enterprise Edition for Itanium-based Systems]", "2003", 2, 5, 2, 0x0002, 2, 0],

 );

 

-plan tests => 3 * (@intel_tests + @amd64_tests + 2*@dual_tests + @ia64_tests);

+plan tests => 6 * (@intel_tests + @amd64_tests + 2*@dual_tests + @ia64_tests);

 

 # Test internal implementation function

 sub check {

     my($test, $arch) = @_;

-    my($pretty, $expect, $id, $major, $minor, $sm, $pt, $metrics, $tag) = @$test;

+    my($pretty, $expect, $id, $major, $minor, $sm, $pt, $metrics) = @$test;

     $metrics = [$metrics] if defined($metrics) && not ref $metrics;

-    $tag ||= "";

 

-    unless ($tag) {

-	($pretty, $tag) = ("$1$2$3", "$2") if $pretty =~ /^(.*)\[(.*)\](.*)$/;

-	($pretty, $tag) = ("$1$2$3", "Windows $2") if $pretty =~ /^(.*)\{(.*)\}(.*)$/;

-	$tag = "R2 $tag" if $tag !~ /R2/ && $pretty =~ /R2$/;

-    }

+    my $tag = "";

+    ($pretty, $tag) = ("$1$2$3", "$2") if $pretty =~ /^(.*)\[(.*)\](.*)$/;

+    ($pretty, $tag) = ("$1$2$3", "Windows $2") if $pretty =~ /^(.*)\{(.*)\}(.*)$/;

+    $tag = "R2 $tag" if $tag !~ /R2/ && $pretty =~ /R2$/;

 

     # All display names start with "Windows";

     # and 2003/2008 start with "Windows Server"

@@ -150,7 +149,17 @@ sub check {
     note($pretty);

     is($display, $pretty);

     is($os, "Win$expect", "os:   $os");

-    is($desc, $tag,       "desc: $desc");

+    is($desc, $tag, "desc: $desc");

+

+    my $sp = "Service Pack 42";

+    ($os, $desc) = Win32::_GetOSName($sp, $major||0, $minor||0, 0,

+				     $id, $sm||0, $pt||1, $sm||0, $arch, $metrics);

+    $display = Win32::GetOSDisplayName($os, $desc);

+

+    is($display, "$pretty $sp", "display: $display");

+    is($os,      "Win$expect",  "os:      $os");

+    $expect = length($tag) ? "$tag $sp" : $sp;

+    is($desc,    $expect,       "desc:    $desc");

 }

 

 check($_, Win32::PROCESSOR_ARCHITECTURE_INTEL) for @intel_tests, @dual_tests;