In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/0d135d25496046c60a195844bcab41bce8b8f5cc?hp=3707930867f717d57fcf64228b8b1fe57e88716a>
- Log ----------------------------------------------------------------- commit 0d135d25496046c60a195844bcab41bce8b8f5cc Author: Jan Dubois <[email protected]> Date: Fri Dec 10 17:45:30 2010 -0800 Update Win32 from CPAN (from 0.40 to 0.41) ----------------------------------------------------------------------- Summary of changes: Porting/Maintainers.pl | 2 +- cpan/Win32/Changes | 20 +++++++++++++++++--- cpan/Win32/Win32.pm | 25 +++++++++++++++++-------- cpan/Win32/Win32.xs | 13 +++++++++++-- cpan/Win32/t/GetOSName.t | 29 +++++++++++++++++++---------- 5 files changed, 65 insertions(+), 24 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 239dbde..d6d87a2 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 7dd8986..24235aa 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 cef6271..d2eb1ad 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 2799290..f6d96b4 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 8c29d30..32a43df 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; -- Perl5 Master Repository
