In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/0e5d25bf51a3de62b6938cc50b508a0107f024bb?hp=d66e82e8086974a3e2dcb5f6cef8318f80b43e22>
- Log ----------------------------------------------------------------- commit 0e5d25bf51a3de62b6938cc50b508a0107f024bb Author: Jan Dubois <[email protected]> Date: Wed Dec 8 14:07:18 2010 -0800 Upgrade Win32 from CPAN (from 0.39 to 0.40) Yes, still has CR/LF line endings; I'll fix it in a CPAN release with no changes but the line-endings fix first. ----------------------------------------------------------------------- Summary of changes: Porting/Maintainers.pl | 2 +- cpan/Win32/Changes | 13 + cpan/Win32/Win32.pm | 553 ++++++++++++++++++++++++++++++++++++++------- cpan/Win32/Win32.xs | 36 +++ cpan/Win32/t/GetOSName.t | 180 ++++++++++++--- 5 files changed, 676 insertions(+), 108 deletions(-) mode change 100644 => 100755 cpan/Win32/Changes mode change 100644 => 100755 cpan/Win32/t/CreateFile.t diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 4a96b5c..08f7e2b 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1556,7 +1556,7 @@ use File::Glob qw(:case); 'Win32' => { 'MAINTAINER' => 'jand', - 'DISTRIBUTION' => "JDB/Win32-0.39.tar.gz", + 'DISTRIBUTION' => "JDB/Win32-0.40.tar.gz", 'FILES' => q[cpan/Win32], 'UPSTREAM' => 'cpan', }, diff --git a/cpan/Win32/Changes b/cpan/Win32/Changes old mode 100644 new mode 100755 index b707793..7dd8986 --- a/cpan/Win32/Changes +++ b/cpan/Win32/Changes @@ -1,5 +1,18 @@ Revision history for the Perl extension Win32. +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). + - Detect "Windows Home Server" as "WinHomeSvr" in Win32::GetOSName() + (used to return "Win2003" before). + - Added "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 + 0.39 [2009-01-19] - Add support for Windows 2008 Server and Windows 7 in Win32::GetOSName() and in the documentation for diff --git a/cpan/Win32/Win32.pm b/cpan/Win32/Win32.pm index bc231ba..cef6271 100644 --- a/cpan/Win32/Win32.pm +++ b/cpan/Win32/Win32.pm @@ -1,6 +1,6 @@ package Win32; -BEGIN { +# BEGIN { use strict; use vars qw|$VERSION $XS_VERSION @ISA @EXPORT @EXPORT_OK|; @@ -8,7 +8,7 @@ BEGIN { require DynaLoader; @ISA = qw|Exporter DynaLoader|; - $VERSION = '0.39'; + $VERSION = '0.40'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -79,7 +79,7 @@ BEGIN { CSIDL_RESOURCES_LOCALIZED CSIDL_CDBURN_AREA ); -} +# } # We won't bother with the constant stuff, too much of a hassle. Just hard # code it here. @@ -154,6 +154,106 @@ sub CSIDL_RESOURCES () { 0x0038 } # %windir%\Resources\, Fo sub CSIDL_RESOURCES_LOCALIZED () { 0x0039 } # %windir%\Resources\<LangID>, for theme and other windows specific resources. sub CSIDL_CDBURN_AREA () { 0x003B } # <user name>\Local Settings\Application Data\Microsoft\CD Burning +sub VER_NT_DOMAIN_CONTROLLER () { 0x0000002 } # The system is a domain controller and the operating system is Windows Server 2008, Windows Server 2003, or Windows 2000 Server. +sub VER_NT_SERVER () { 0x0000003 } # The operating system is Windows Server 2008, Windows Server 2003, or Windows 2000 Server. +# Note that a server that is also a domain controller is reported as VER_NT_DOMAIN_CONTROLLER, not VER_NT_SERVER. +sub VER_NT_WORKSTATION () { 0x0000001 } # The operating system is Windows Vista, Windows XP Professional, Windows XP Home Edition, or Windows 2000 Professional. + + +sub VER_SUITE_BACKOFFICE () { 0x00000004 } # Microsoft BackOffice components are installed. +sub VER_SUITE_BLADE () { 0x00000400 } # Windows Server 2003, Web Edition is installed. +sub VER_SUITE_COMPUTE_SERVER () { 0x00004000 } # Windows Server 2003, Compute Cluster Edition is installed. +sub VER_SUITE_DATACENTER () { 0x00000080 } # Windows Server 2008 Datacenter, Windows Server 2003, Datacenter Edition, or Windows 2000 Datacenter Server is installed. +sub VER_SUITE_ENTERPRISE () { 0x00000002 } # Windows Server 2008 Enterprise, Windows Server 2003, Enterprise Edition, or Windows 2000 Advanced Server is installed. Refer to the Remarks ... [50 chars truncated] +sub VER_SUITE_EMBEDDEDNT () { 0x00000040 } # Windows XP Embedded is installed. +sub VER_SUITE_PERSONAL () { 0x00000200 } # Windows Vista Home Premium, Windows Vista Home Basic, or Windows XP Home Edition is installed. +sub VER_SUITE_SINGLEUSERTS () { 0x00000100 } # Remote Desktop is supported, but only one interactive session is supported. This value is set unless the system is running in application se ... [11 chars truncated] +sub VER_SUITE_SMALLBUSINESS () { 0x00000001 } # Microsoft Small Business Server was once installed on the system, but may have been upgraded to another version of Windows. Refer to the Rem ... [55 chars truncated] +sub VER_SUITE_SMALLBUSINESS_RESTRICTED () { 0x00000020 } # Microsoft Small Business Server is installed with the restrictive client license in force. Refer to the Remarks section for more information ... [22 chars truncated] +sub VER_SUITE_STORAGE_SERVER () { 0x00002000 } # Windows Storage Server 2003 R2 or Windows Storage Server 2003 is installed. +sub VER_SUITE_TERMINAL () { 0x00000010 } # Terminal Services is installed. This value is always set. +# If VER_SUITE_TERMINAL is set but VER_SUITE_SINGLEUSERTS is not set, the system is running in application server mode. +sub VER_SUITE_WH_SERVER () { 0x00008000 } # Windows Home Server is installed. + + +sub SM_TABLETPC () { 86 } +sub SM_MEDIACENTER () { 87 } +sub SM_STARTER () { 88 } +sub SM_SERVERR2 () { 89 } + +sub PRODUCT_UNDEFINED () { 0x000 } # An unknown product +sub PRODUCT_ULTIMATE () { 0x001 } # Ultimate +sub PRODUCT_HOME_BASIC () { 0x002 } # Home Basic +sub PRODUCT_HOME_PREMIUM () { 0x003 } # Home Premium +sub PRODUCT_ENTERPRISE () { 0x004 } # Enterprise +sub PRODUCT_HOME_BASIC_N () { 0x005 } # Home Basic N +sub PRODUCT_BUSINESS () { 0x006 } # Business +sub PRODUCT_STANDARD_SERVER () { 0x007 } # Server Standard (full installation) +sub PRODUCT_DATACENTER_SERVER () { 0x008 } # Server Datacenter (full installation) +sub PRODUCT_SMALLBUSINESS_SERVER () { 0x009 } # Windows Small Business Server +sub PRODUCT_ENTERPRISE_SERVER () { 0x00A } # Server Enterprise (full installation) +sub PRODUCT_STARTER () { 0x00B } # Starter +sub PRODUCT_DATACENTER_SERVER_CORE () { 0x00C } # Server Datacenter (core installation) +sub PRODUCT_STANDARD_SERVER_CORE () { 0x00D } # Server Standard (core installation) +sub PRODUCT_ENTERPRISE_SERVER_CORE () { 0x00E } # Server Enterprise (core installation) +sub PRODUCT_ENTERPRISE_SERVER_IA64 () { 0x00F } # Server Enterprise for Itanium-based Systems +sub PRODUCT_BUSINESS_N () { 0x010 } # Business N +sub PRODUCT_WEB_SERVER () { 0x011 } # Web Server (full installation) +sub PRODUCT_CLUSTER_SERVER () { 0x012 } # HPC Edition +sub PRODUCT_HOME_SERVER () { 0x013 } # Home Server Edition +sub PRODUCT_STORAGE_EXPRESS_SERVER () { 0x014 } # Storage Server Express +sub PRODUCT_STORAGE_STANDARD_SERVER () { 0x015 } # Storage Server Standard +sub PRODUCT_STORAGE_WORKGROUP_SERVER () { 0x016 } # Storage Server Workgroup +sub PRODUCT_STORAGE_ENTERPRISE_SERVER () { 0x017 } # Storage Server Enterprise +sub PRODUCT_SERVER_FOR_SMALLBUSINESS () { 0x018 } # Windows Server 2008 for Windows Essential Server Solutions +sub PRODUCT_SMALLBUSINESS_SERVER_PREMIUM () { 0x019 } # Windows Small Business Server Premium +sub PRODUCT_HOME_PREMIUM_N () { 0x01A } # Home Premium N +sub PRODUCT_ENTERPRISE_N () { 0x01B } # Enterprise N +sub PRODUCT_ULTIMATE_N () { 0x01C } # Ultimate N +sub PRODUCT_WEB_SERVER_CORE () { 0x01D } # Web Server (core installation) +sub PRODUCT_MEDIUMBUSINESS_SERVER_MANAGEMENT () { 0x01E } # Windows Essential Business Server Management Server +sub PRODUCT_MEDIUMBUSINESS_SERVER_SECURITY () { 0x01F } # Windows Essential Business Server Security Server +sub PRODUCT_MEDIUMBUSINESS_SERVER_MESSAGING () { 0x020 } # Windows Essential Business Server Messaging Server +sub PRODUCT_SERVER_FOUNDATION () { 0x021 } # Server Foundation + +sub PRODUCT_SERVER_FOR_SMALLBUSINESS_V () { 0x023 } # Windows Server 2008 without Hyper-V for Windows Essential Server Solutions +sub PRODUCT_STANDARD_SERVER_V () { 0x024 } # Server Standard without Hyper-V (full installation) +sub PRODUCT_DATACENTER_SERVER_V () { 0x025 } # Server Datacenter without Hyper-V (full installation) +sub PRODUCT_ENTERPRISE_SERVER_V () { 0x026 } # Server Enterprise without Hyper-V (full installation) +sub PRODUCT_DATACENTER_SERVER_CORE_V () { 0x027 } # Server Datacenter without Hyper-V (core installation) +sub PRODUCT_STANDARD_SERVER_CORE_V () { 0x028 } # Server Standard without Hyper-V (core installation) +sub PRODUCT_ENTERPRISE_SERVER_CORE_V () { 0x029 } # Server Enterprise without Hyper-V (core installation) +sub PRODUCT_HYPERV () { 0x02A } # Microsoft Hyper-V Server + +sub PRODUCT_STARTER_N () { 0x02F } # Starter N +sub PRODUCT_PROFESSIONAL () { 0x030 } # Professional +sub PRODUCT_PROFESSIONAL_N () { 0x031 } # Professional N + +sub PRODUCT_STARTER_E () { 0x042 } # Starter E +sub PRODUCT_HOME_BASIC_E () { 0x043 } # Home Basic E +sub PRODUCT_HOME_PREMIUM_E () { 0x044 } # Home Premium E +sub PRODUCT_PROFESSIONAL_E () { 0x045 } # Professional E +sub PRODUCT_ENTERPRISE_E () { 0x046 } # Enterprise E +sub PRODUCT_ULTIMATE_E () { 0x047 } # Ultimate E + +sub PRODUCT_UNLICENSED () { 0xABCDABCD } # product has not been activated and is no longer in the grace period + +sub PROCESSOR_ARCHITECTURE_AMD64 () { 9 } # x64 (AMD or Intel) +sub PROCESSOR_ARCHITECTURE_IA64 () { 6 } # Intel Itanium Processor Family (IPF) +sub PROCESSOR_ARCHITECTURE_INTEL () { 0 } # x86 +sub PROCESSOR_ARCHITECTURE_UNKNOWN () { 0xffff } # Unknown architecture. + +sub _GetProcessorArchitecture { + my $arch = { + 386 => PROCESSOR_ARCHITECTURE_INTEL, + 486 => PROCESSOR_ARCHITECTURE_INTEL, + 586 => PROCESSOR_ARCHITECTURE_INTEL, + 2200 => PROCESSOR_ARCHITECTURE_IA64, + 8664 => PROCESSOR_ARCHITECTURE_AMD64, + }->{Win32::GetChipName()}; + return defined($arch) ? $arch : PROCESSOR_ARCHITECTURE_UNKNOWN; +} + ### This method is just a simple interface into GetOSVersion(). More ### specific or demanding situations should use that instead. @@ -161,22 +261,69 @@ my ($cached_os, $cached_desc); sub GetOSName { unless (defined $cached_os) { - my($desc, $major, $minor, $build, $id, undef, undef, undef, $producttype) + my($desc, $major, $minor, $build, $id, undef, undef, $suitemask, $producttype) = Win32::GetOSVersion(); - ($cached_os, $cached_desc) = _GetOSName($desc, $major, $minor, $build, $id, $producttype); + my $arch = _GetProcessorArchitecture(); + my $productinfo = Win32::GetProductInfo(6, 0, 0, 0); + ($cached_os, $cached_desc) = _GetOSName($desc, $major, $minor, $build, $id, + $suitemask, $producttype, $productinfo, $arch); } return wantarray ? ($cached_os, $cached_desc) : $cached_os; } +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") { + ($name, $desc) = ($desc, ""); + } + elsif ($desc =~ s/\s*(Windows (.*) Server( \d+)?)$//) { + ($name, $desc) = ("$1 $name", $desc); + } + else { + for ($name) { + s/^/Windows / unless /^Win32s$/; + s/\/.Net//; + s/NT(\d)/NT $1/; + if ($desc =~ s/\s*(HPC|Small Business|Web) Server//) { + my $name = $1; + $desc =~ s/^\s*//; + s/(200.)/$name Server $1/; + } + s/^Windows (200[38])/Windows Server $1/; + } + } + $name .= " $desc" if length $desc; + return $name; +} + +sub _GetSystemMetrics { + my($index,$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); +} + sub _GetOSName { - my($desc, $major, $minor, $build, $id, $producttype) = @_; + # The $metrics argument only exists for the benefit of t/GetOSName.t + my($csd, $major, $minor, $build, $id, $suitemask, $producttype, $productinfo, $arch, $metrics) = @_; - my($os,$tag); + my($os,@tags); + my $desc = ""; if ($id == 0) { $os = "Win32s"; } elsif ($id == 1) { - $os = { 0 => "95", 10 => "98", 90 => "Me" }->{$minor}; + if ($minor == 0) { + $os = "95"; + } + elsif ($minor == 10) { + $os = "98"; + } + elsif ($minor == 90) { + $os = "Me"; + } } elsif ($id == 2) { if ($major == 3) { @@ -186,12 +333,193 @@ sub _GetOSName { $os = "NT4"; } elsif ($major == 5) { - $os = { 0 => "2000", 1 => "XP/.Net", 2 => "2003" }->{$minor}; + if ($minor == 0) { + $os = "2000"; + if ($producttype == VER_NT_WORKSTATION) { + $desc = "Professional"; + } + else { + if ($suitemask & VER_SUITE_DATACENTER) { + $desc = "Datacenter Server"; + } + elsif ($suitemask & VER_SUITE_ENTERPRISE) { + $desc = "Advanced Server"; + } + elsif ($suitemask & VER_SUITE_SMALLBUSINESS_RESTRICTED) { + $desc = "Small Business Server"; + } + else { + $desc = "Server"; + } + } + # XXX ignoring "Windows 2000 Advanced Server Limited Edition" for Itanium + # XXX and "Windows 2000 Datacenter Server Limited Edition" for Itanium + } + elsif ($minor == 1) { + $os = "XP/.Net"; + if (_GetSystemMetrics(SM_MEDIACENTER, $metrics)) { + $desc = "Media Center Edition"; + } + elsif (_GetSystemMetrics(SM_TABLETPC, $metrics)) { + # Tablet PC Edition is based on XP Pro + $desc = "Tablet PC Edition"; + } + elsif (_GetSystemMetrics(SM_STARTER, $metrics)) { + $desc = "Starter Edition"; + } + elsif ($suitemask & VER_SUITE_PERSONAL) { + $desc = "Home Edition"; + } + else { + $desc = "Professional"; + } + # XXX ignoring all Windows XP Embedded and Fundamentals versions + } + elsif ($minor == 2) { + $os = "2003"; + + if (_GetSystemMetrics(SM_SERVERR2, $metrics)) { + # XXX R2 was released for all x86 and x64 versions, + # XXX but only Enterprise Edition for Itanium. + $desc = "R2"; + } + + if ($suitemask == VER_SUITE_STORAGE_SERVER) { + $desc .= " Windows Storage Server"; + } + elsif ($suitemask == VER_SUITE_WH_SERVER) { + $desc .= " Windows Home Server"; + } + elsif ($producttype == VER_NT_WORKSTATION && $arch == PROCESSOR_ARCHITECTURE_AMD64) { + $desc .= " Windows XP Professional x64 Edition"; + } + + # Test for the server type. + if ($producttype != VER_NT_WORKSTATION) { + if ($arch == PROCESSOR_ARCHITECTURE_IA64) { + if ($suitemask & VER_SUITE_DATACENTER) { + $desc .= " Datacenter Edition for Itanium-based Systems"; + } + elsif ($suitemask & VER_SUITE_ENTERPRISE) { + $desc .= " Enterprise Edition for Itanium-based Systems"; + } + } + elsif ($arch == PROCESSOR_ARCHITECTURE_AMD64) { + if ($suitemask & VER_SUITE_DATACENTER) { + $desc .= " Datacenter x64 Edition"; + } + elsif ($suitemask & VER_SUITE_ENTERPRISE) { + $desc .= " Enterprise x64 Edition"; + } + else { + $desc .= " Standard x64 Edition"; + } + } + else { + if ($suitemask & VER_SUITE_COMPUTE_SERVER) { + $desc .= " Windows Compute Cluster Server"; + } + elsif ($suitemask & VER_SUITE_DATACENTER) { + $desc .= " Datacenter Edition"; + } + elsif ($suitemask & VER_SUITE_ENTERPRISE) { + $desc .= " Enterprise Edition"; + } + elsif ($suitemask & VER_SUITE_BLADE) { + $desc .= " Web Edition"; + } + elsif ($suitemask & VER_SUITE_SMALLBUSINESS_RESTRICTED) { + $desc .= " Small Business Server"; + } + else { + if ($desc !~ /Windows (Home|Storage) Server/) { + $desc .= " Standard Edition"; + } + } + } + } + } } 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; + if ($minor == 0) { + if ($producttype == VER_NT_WORKSTATION) { + $os = "Vista"; + } + else { + $os = "2008"; + } + } + elsif ($minor == 1) { + if ($producttype == VER_NT_WORKSTATION) { + $os = "7"; + } + else { + $os = "2008"; + $desc = "R2"; + } + } + + if ($productinfo == PRODUCT_ULTIMATE) { + $desc .= " Ultimate"; + } + elsif ($productinfo == PRODUCT_HOME_PREMIUM) { + $desc .= " Home Premium"; + } + elsif ($productinfo == PRODUCT_HOME_BASIC) { + $desc .= " Home Basic"; + } + elsif ($productinfo == PRODUCT_ENTERPRISE) { + $desc .= " Enterprise"; + } + elsif ($productinfo == PRODUCT_BUSINESS) { + $desc .= " Business"; + } + elsif ($productinfo == PRODUCT_STARTER) { + $desc .= " Starter"; + } + elsif ($productinfo == PRODUCT_CLUSTER_SERVER) { + $desc .= " HPC Server"; + } + elsif ($productinfo == PRODUCT_DATACENTER_SERVER) { + $desc .= " Datacenter"; + } + elsif ($productinfo == PRODUCT_DATACENTER_SERVER_CORE) { + $desc .= " Datacenter Edition (core installation)"; + } + elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER) { + $desc .= " Enterprise"; + } + elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER_CORE) { + $desc .= " Enterprise Edition (core installation)"; + } + elsif ($productinfo == PRODUCT_ENTERPRISE_SERVER_IA64) { + $desc .= " Enterprise Edition for Itanium-based Systems"; + } + elsif ($productinfo == PRODUCT_SMALLBUSINESS_SERVER) { + $desc .= " Small Business Server"; + } + elsif ($productinfo == PRODUCT_SMALLBUSINESS_SERVER_PREMIUM) { + $desc .= " Small Business Server Premium Edition"; + } + elsif ($productinfo == PRODUCT_STANDARD_SERVER) { + $desc .= " Standard"; + } + elsif ($productinfo == PRODUCT_STANDARD_SERVER_CORE) { + $desc .= " Standard Edition (core installation)"; + } + elsif ($productinfo == PRODUCT_WEB_SERVER) { + $desc .= " Web Server"; + } + elsif ($productinfo == PRODUCT_PROFESSIONAL) { + $desc .= " Professional"; + } + + if ($arch == PROCESSOR_ARCHITECTURE_INTEL) { + $desc .= " (32-bit)"; + } + elsif ($arch == PROCESSOR_ARCHITECTURE_AMD64) { + $desc .= " (64-bit)"; + } } } @@ -200,19 +528,29 @@ sub _GetOSName { return; } - # 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}; + for ($desc) { + s/\s\s+/ /g; + s/^\s//; + s/\s$//; } - elsif ($os eq "98" && $build eq "67766446") { - $tag = "(2nd ed)"; + + # XXX What about "Small Business Server"? NT, 200, 2003, 2008 editions... + + if ($major >= 5) { + # XXX XP, Vista, 7 all have starter editions + #push(@tags, "Starter Edition") if _GetSystemMetrics(SM_STARTER, $metrics); } - if ($tag) { - $desc = length($desc) ? "$tag $desc" : $tag; + + if (@tags) { + unshift(@tags, $desc) if length $desc; + $desc = join(" ", @tags); } - return ("Win$os", $desc); + if (length $csd) { + $desc .= " " if length $desc; + $desc .= $csd; + } + return ("Win$os", $desc); } # "no warnings 'redefine';" doesn't work for 5.8.7 and earlier @@ -366,8 +704,8 @@ $ENV{PROCESSOR_ARCHITECTURE}. This might not work on Win9X. =item Win32::GetChipName() -Returns the processor type: 386, 486 or 586 for Intel processors, -21064 for the Alpha chip. +Returns the processor type: 386, 486 or 586 for x86 processors, +8664 for the x64 processor and 2200 for the Itanium. =item Win32::GetCwd() @@ -505,6 +843,68 @@ before passing the path to a system call or another program. [CORE] Returns a string in the form of "<d>:" where <d> is the first available drive letter. +=item Win32::GetOSDisplayName() + +Returns the "marketing" name of the Windows operating system version +being used. It returns names like these (random samples): + + Windows 2000 Datacenter Server + Windows XP Professional + Windows XP Tablet PC Edition + Windows Home Server + Windows Server 2003 Enterprise Edition for Itanium-based Systems + Windows Vista Ultimate (32-bit) + Windows Small Business Server 2008 R2 (64-bit) + +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, +Win32::GetProductInfo() and Win32::GetSystemMetrics() functions provide +the base information to check for certain capabilities, or for families +of OS releases. + +=item Win32::GetOSName() + +In scalar context returns the name of the Win32 operating system +being used. In list context returns a two element list of the OS name +and whatever edition information is known about the particular build +(for Win9X boxes) and whatever service packs have been installed. +The latter is roughly equivalent to the first item returned by +GetOSVersion() in list context. + +The description will also include tags for other special editions, +like "R2", "Media Center", "Tablet PC", or "Starter Edition". + +Currently the possible values for the OS name are + + WinWin32s + Win95 + Win98 + WinMe + WinNT3.51 + WinNT4 + Win2000 + WinXP/.Net + Win2003 + WinHomeSvr + WinVista + Win2008 + Win7 + +This routine is just a simple interface into GetOSVersion(). More +specific or demanding situations should use that instead. Another +option would be to use POSIX::uname(), however the latter appears to +report only the OS family name and not the specific OS. In scalar +context it returns just the ID. + +The name "WinXP/.Net" is used for historical reasons only, to maintain +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::GetOSVersion() [CORE] Returns the list (STRING, MAJOR, MINOR, BUILD, ID), where the @@ -517,26 +917,40 @@ the ID. Currently known values for ID MAJOR and MINOR are as follows: - OS ID MAJOR MINOR - Win32s 0 - - - Windows 95 1 4 0 - Windows 98 1 4 10 - Windows Me 1 4 90 - Windows NT 3.51 2 3 51 - Windows NT 4 2 4 0 - Windows 2000 2 5 0 - 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 + OS ID MAJOR MINOR + Win32s 0 - - + Windows 95 1 4 0 + Windows 98 1 4 10 + Windows Me 1 4 90 + + Windows NT 3.51 2 3 51 + Windows NT 4 2 4 0 + + Windows 2000 2 5 0 + Windows XP 2 5 1 + Windows Server 2003 2 5 2 + Windows Server 2003 R2 2 5 2 + Windows Home Server 2 5 2 + + Windows Vista 2 6 0 + Windows Server 2008 2 6 0 + Windows 7 2 6 1 + Windows Server 2008 R2 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 2003 and Windows Home Server are +identical; the SUITEMASK field must be used to differentiate between\ +them. + The version numbers for Windows Vista and Windows Server 2008 are -identical; the PRODUCTTYPE field must be used to differentiate -between them. +identical; the PRODUCTTYPE field must be used to differentiate between +them. + +The version numbers for Windows 7 and Windows Server 2008 R2 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. @@ -557,6 +971,9 @@ the system. Known bits are: VER_SUITE_BLADE 0x00000400 VER_SUITE_EMBEDDED_RESTRICTED 0x00000800 VER_SUITE_SECURITY_APPLIANCE 0x00001000 + VER_SUITE_STORAGE_SERVER 0x00002000 + VER_SUITE_COMPUTE_SERVER 0x00004000 + VER_SUITE_WH_SERVER 0x00008000 The VER_SUITE_xxx names are listed here to crossreference the Microsoft documentation. The Win32 module does not provide symbolic names for these @@ -572,44 +989,6 @@ be one of the following integer values: Note that a server that is also a domain controller is reported as PRODUCTTYPE 2 (Domaincontroller) and not PRODUCTTYPE 3 (Server). -=item Win32::GetOSName() - -In scalar context returns the name of the Win32 operating system -being used. In list context returns a two element list of the OS name -and whatever edition information is known about the particular build -(for Win9X boxes) and whatever service packs have been installed. -The latter is roughly equivalent to the first item returned by -GetOSVersion() in list context. - -Currently the possible values for the OS name are - - 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 -option would be to use POSIX::uname(), however the latter appears to -report only the OS family name and not the specific OS. In scalar -context it returns just the ID. - -The name "WinXP/.Net" is used for historical reasons only, to maintain -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 @@ -620,6 +999,13 @@ path containing spaces. Returns C<undef> when the PATHNAME does not exist. Compare with Win32::GetFullPathName() and Win32::GetLongPathName(). +=item Win32::GetSystemMetrics(INDEX) + +Retrieves the specified system metric or system configuration setting. +Please refer to the Microsoft documentation of the GetSystemMetrics() +function for a reference of available INDEX values. All system +metrics return integer values. + =item Win32::GetProcAddress(INSTANCE, PROCNAME) Returns the address of a function inside a loaded library. The @@ -627,6 +1013,19 @@ information about what you can do with this address has been lost in the mist of time. Use the Win32::API module instead of this deprecated function. +=item Win32::GetProductInfo(OSMAJOR, OSMINOR, SPMAJOR, SPMINOR) + +Retrieves the product type for the operating system on the local +computer, and maps the type to the product types supported by the +specified operating system. Please refer to the Microsoft +documentation of the GetProductInfo() function for more information +about the parameters and return value. This function requires Windows +Vista or later. + +See also the Win32::GetOSName() and Win32::GetOSDisplayName() +functions which provide a higher level abstraction of the data +returned by this function. + =item Win32::GetTickCount() [CORE] Returns the number of milliseconds elapsed since the last @@ -645,7 +1044,7 @@ The return value is formatted according to OLE conventions, as groups of hex digits with surrounding braces. For example: {09531CF1-D0C7-4860-840C-1C8C8735E2AD} - + =item Win32::InitiateSystemShutdown (MACHINE, MESSAGE, TIMEOUT, FORCECLOSE, REBOOT) diff --git a/cpan/Win32/Win32.xs b/cpan/Win32/Win32.xs index 1ccdcc3..2799290 100644 --- a/cpan/Win32/Win32.xs +++ b/cpan/Win32/Win32.xs @@ -38,6 +38,7 @@ typedef BOOL (__stdcall *PFNAllocateAndInitializeSid)(PSID_IDENTIFIER_AUTHORITY, 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*); #ifndef CSIDL_MYMUSIC # define CSIDL_MYMUSIC 0x000D @@ -1651,6 +1652,39 @@ XS(w32_CreateFile) XSRETURN(1); } +XS(w32_GetSystemMetrics) +{ + dXSARGS; + + if (items != 1) + Perl_croak(aTHX_ "usage: Win32::GetSystemMetrics($index)"); + + XSRETURN_IV(GetSystemMetrics(SvIV(ST(0)))); +} + +XS(w32_GetProductInfo) +{ + dXSARGS; + DWORD type; + HMODULE module; + PFNGetProductInfo pfnGetProductInfo; + + if (items != 4) + Perl_croak(aTHX_ "usage: Win32::GetProductInfo($major,$minor,$spmajor,$spminor)"); + + module = GetModuleHandle("kernel32.dll"); + GETPROC(GetProductInfo); + if (pfnGetProductInfo && + pfnGetProductInfo((DWORD)SvIV(ST(0)), (DWORD)SvIV(ST(1)), + (DWORD)SvIV(ST(2)), (DWORD)SvIV(ST(3)), &type)) + { + XSRETURN_IV(type); + } + + /* PRODUCT_UNDEFINED */ + XSRETURN_IV(0); +} + MODULE = Win32 PACKAGE = Win32 PROTOTYPES: DISABLE @@ -1712,6 +1746,8 @@ BOOT: newXS("Win32::GetCurrentThreadId", w32_GetCurrentThreadId, file); newXS("Win32::CreateDirectory", w32_CreateDirectory, file); newXS("Win32::CreateFile", w32_CreateFile, file); + newXS("Win32::GetSystemMetrics", w32_GetSystemMetrics, file); + newXS("Win32::GetProductInfo", w32_GetProductInfo, file); #ifdef __CYGWIN__ newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file); #endif diff --git a/cpan/Win32/t/CreateFile.t b/cpan/Win32/t/CreateFile.t old mode 100644 new mode 100755 diff --git a/cpan/Win32/t/GetOSName.t b/cpan/Win32/t/GetOSName.t index a7ed9d5..8c29d30 100644 --- a/cpan/Win32/t/GetOSName.t +++ b/cpan/Win32/t/GetOSName.t @@ -1,39 +1,159 @@ use strict; -use Test; +use Test::More; 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 ], +# The "description" value is extracted from the $pretty field: +# +# "2000 [Server]" => "Server" +# "{Home Server}" => "Windows Home Server" (prefixed with "Windows ") +# "Anything R2" => "R2 Anything" (R2 moved to front) +# +# 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 + +my @intel_tests = ( +["Win32s", "Win32s", 0 ], + +["95", "95", 1, 4, 0 ], +["98", "98", 1, 4, 10 ], +["Me", "Me", 1, 4, 90 ], + +["NT 3.51", "NT3.51", 2, 3, 51 ], +["NT 4", "NT4", 2, 4, 0 ], + +["2000 [Professional]", "2000", 2, 5, 0, 0x0000, 1, 0], +["2000 [Server]", "2000", 2, 5, 0, 0x0000, 2, 0], +["[Small Business Server] 2000", "2000", 2, 5, 0, 0x0020, 2, 0], +["2000 [Advanced Server]", "2000", 2, 5, 0, 0x0002, 2, 0], +["2000 [Datacenter Server]", "2000", 2, 5, 0, 0x0080, 2, 0], + +["XP [Home Edition]", "XP/.Net", 2, 5, 1, 0x0200, 1, 0], +["XP [Professional]", "XP/.Net", 2, 5, 1, 0x0000, 1, 0], +["XP [Tablet PC Edition]", "XP/.Net", 2, 5, 1, 0x0000, 1, 86], +["XP [Media Center Edition]", "XP/.Net", 2, 5, 1, 0x0000, 1, 87], +["XP [Starter Edition]", "XP/.Net", 2, 5, 1, 0x0000, 1, 88], + +["2003 [Standard Edition]", "2003", 2, 5, 2, 0x0000, 2, 0], +["[Small Business Server] 2003", "2003", 2, 5, 2, 0x0020, 2, 0], +["{Storage Server} 2003", "2003", 2, 5, 2, 0x2000, 2, 0], +["{Home Server}", "2003", 2, 5, 2, 0x8000, 2, 0], + +["{Compute Cluster Server} 2003", "2003", 2, 5, 2, 0x4000, 2, 0], +["2003 [Datacenter Edition]", "2003", 2, 5, 2, 0x0080, 2, 0], +["2003 [Enterprise Edition]", "2003", 2, 5, 2, 0x0002, 2, 0], +["2003 [Web Edition]", "2003", 2, 5, 2, 0x0400, 2, 0], + +["2003 [R2 Standard Edition]", "2003", 2, 5, 2, 0x0000, 2, 89], +["[Small Business Server] 2003 R2", "2003", 2, 5, 2, 0x0020, 2, 89], +["{Storage Server} 2003 R2", "2003", 2, 5, 2, 0x2000, 2, 89], +# ??? test for more R2 versions? +); + +my @amd64_tests = ( +["{XP Professional x64 Edition}", "2003", 2, 5, 2, 0x0000, 1, 0], +["2003 [Datacenter x64 Edition]", "2003", 2, 5, 2, 0x0080, 2, 0], +["2003 [Enterprise x64 Edition]", "2003", 2, 5, 2, 0x0002, 2, 0], +["2003 [Standard x64 Edition]", "2003", 2, 5, 2, 0x0000, 2, 0], ); -plan tests => 2*scalar(@tests) + 1; +my @dual_tests = ( +["Vista", "Vista", 2, 6, 0 ], + +["Vista [Starter]", "Vista", 2, 6, 0, 0x0b ], +["Vista [Home Basic]", "Vista", 2, 6, 0, 0x02 ], +["Vista [Home Premium]", "Vista", 2, 6, 0, 0x03 ], +["Vista [Business]", "Vista", 2, 6, 0, 0x06 ], +["Vista [Enterprise]", "Vista", 2, 6, 0, 0x04 ], +["Vista [Ultimate]", "Vista", 2, 6, 0, 0x01 ], + +#["Vista Business for Embedded Systems", "Vista", 2, 6, 0 ], +#["Vista Ultimate for Embedded Systems", "Vista", 2, 6, 0 ], + +["2008 [Standard]", "2008", 2, 6, 0, 0x07, 2 ], +["2008 [Enterprise]", "2008", 2, 6, 0, 0x04, 2 ], +["[HPC Server] 2008", "2008", 2, 6, 0, 0x12, 2 ], +["[Web Server] 2008", "2008", 2, 6, 0, 0x11, 2 ], +#["[Storage Server] 2008", "2008", 2, 6, 0, ????, 2 ], +["[Small Business Server] 2008", "2008", 2, 6, 0, 0x09, 2, 0 ], + +# * Windows Server 2008 Standard (x86 and x86-64) +# * Windows Server 2008 Enterprise (x86 and x86-64) +# * Windows HPC Server 2008 (replacing Windows Compute Cluster Server 2003) +# * Windows Web Server 2008 (x86 and x86-64) +# * Windows Storage Server 2008 (x86 and x86-64) +# * Windows Small Business Server 2008 (Codenamed "Cougar") (x86-64) for small businesses +# * Windows Essential Business Server 2008 (Codenamed "Centro") (x86-64) for medium-sized businesses [25] +# * Windows Server 2008 for Itanium-based Systems +# * Windows Server 2008 Foundation +# +# Server Core is available in the Web, Standard, Enterprise and Datacenter editions. + +["7", "7", 2, 6, 1 ], +["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, 0x30 ], +["7 [Enterprise]", "7", 2, 6, 1, 0x04 ], +["7 [Ultimate]", "7", 2, 6, 1, 0x01 ], + + +["2008 [R2]", "2008", 2, 6, 1, 0x00, 2, 89 ], +["[Small Business Server] 2008 R2", "2008", 2, 6, 1, 0x09, 2, 89 ], + +); + +my @ia64_tests = ( +["2003 [Datacenter Edition for Itanium-based Systems]", "2003", 2, 5, 2, 0x0080, 2, 0], +["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); # 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||""); +sub check { + my($test, $arch) = @_; + my($pretty, $expect, $id, $major, $minor, $sm, $pt, $metrics, $tag) = @$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$/; + } + + # All display names start with "Windows"; + # and 2003/2008 start with "Windows Server" + unless ($pretty eq "Win32s") { + my $prefix = "Windows"; + $prefix .= " Server" if $pretty =~ /^200[38]/; + $pretty = "$prefix $pretty"; + } + + # @dual_tests: Vista and later all come in both 32-bit and 64-bit versions + if ($id == 2 && $major >= 6) { + my $suffix = ""; + $suffix = " (32-bit)" if $arch == Win32::PROCESSOR_ARCHITECTURE_INTEL; + $suffix = " (64-bit)" if $arch == Win32::PROCESSOR_ARCHITECTURE_AMD64; + $_ .= $suffix for $pretty, $tag; + $tag =~ s/^\s*//; + } + + # We pass the same value for $suitemask and $productinfo. The former is + # used for Windows up to 2003, the latter is used for Vista and later. + my($os, $desc) = Win32::_GetOSName("", $major||0, $minor||0, 0, + $id, $sm||0, $pt||1, $sm||0, $arch, $metrics); + my $display = Win32::GetOSDisplayName($os, $desc); + + note($pretty); + is($display, $pretty); + is($os, "Win$expect", "os: $os"); + is($desc, $tag, "desc: $desc"); } -# 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); +check($_, Win32::PROCESSOR_ARCHITECTURE_INTEL) for @intel_tests, @dual_tests; +check($_, Win32::PROCESSOR_ARCHITECTURE_AMD64) for @amd64_tests, @dual_tests; +check($_, Win32::PROCESSOR_ARCHITECTURE_IA64) for @ia64_tests; + -- Perl5 Master Repository
