Fix [perl #66970] Incorrect coderef in MODIFY_CODE_ATTRIBUTES
[p5sagit/p5-mst-13.2.git] / ext / Win32 / Win32.pm
index 116d3f5..4015eac 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     require DynaLoader;
 
     @ISA = qw|Exporter DynaLoader|;
-    $VERSION = '0.29';
+    $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;
+       }
+    }
 
-        # cache the results, so we dont have to do this again
-        $found_os      = "Win$os";
-        $found_desc    = $desc;
+    unless (defined $os) {
+       warn "Unknown Windows version [$id:$major:$minor]";
+       return;
     }
 
-    return wantarray ? ($found_os, $found_desc) : $found_os;
+    # 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 ("Win$os", $desc);
 }
 
 # "no warnings 'redefine';" doesn't work for 5.8.7 and earlier
@@ -310,9 +286,10 @@ a name that can be passed to system calls and external programs.
 
 =item Win32::DomainName()
 
-[CORE] Returns the name of the Microsoft Network domain that the
-owner of the current perl process is logged into.  This function does
-B<not> work on Windows 9x.
+[CORE] Returns the name of the Microsoft Network domain or workgroup
+that the owner of the current perl process is logged into.  The
+"Workstation" service must be running to determine this
+information.  This function does B<not> work on Windows 9x.
 
 =item Win32::ExpandEnvironmentStrings(STRING)
 
@@ -402,15 +379,25 @@ If supported by the core Perl version, this function will return an
 ANSI path name for the current directory if the long pathname cannot
 be represented in the system codepage.
 
+=item Win32::GetCurrentProcessId()
+
+Returns the process identifier of the current process.  Until the
+process terminates, the process identifier uniquely identifies the
+process throughout the system.
+
+The current process identifier is normally also available via the
+predefined $$ variable.  Under fork() emulation however $$ may contain
+a pseudo-process identifier that is only meaningful to the Perl
+kill(), wait() and waitpid() functions.  The
+Win32::GetCurrentProcessId() function will always return the regular
+Windows process id, even when called from inside a pseudo-process.
+
 =item Win32::GetCurrentThreadId()
 
 Returns the thread identifier of the calling thread.  Until the thread
 terminates, the thread identifier uniquely identifies the thread
 throughout the system.
 
-Note: the current process identifier is available via the predefined
-$$ variable.
-
 =item Win32::GetFileVersion(FILENAME)
 
 Returns the file version number from the VERSIONINFO resource of
@@ -525,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.  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:
 
@@ -540,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.
 
@@ -571,9 +565,12 @@ constants.
 PRODUCTTYPE provides additional information about the system.  It should
 be one of the following integer values:
 
-    1 - Workstation (NT 4, 2000 Pro, XP Home, XP Pro)
+    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()
 
@@ -586,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
+    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
@@ -599,13 +607,17 @@ 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
 (8.3) path components where available.  For path components where the
 file system has not generated the short form the returned path will
 use the long form, so this function might still for instance return a
-path containing spaces.  Compare with Win32::GetFullPathName() and
+path containing spaces.  Returns C<undef> when the PATHNAME does not
+exist. Compare with Win32::GetFullPathName() and
 Win32::GetLongPathName().
 
 =item Win32::GetProcAddress(INSTANCE, PROCNAME)
@@ -650,8 +662,8 @@ Returns non zero if the account in whose security context the
 current process/thread is running belongs to the local group of
 Administrators in the built-in system domain; returns 0 if not.
 On Windows Vista it will only return non-zero if the process is
-actually running with elevated privileges.  Returns the undefined
-value and prints a warning if an error occurred.  This function always
+actually running with elevated privileges.  Returns C<undef>
+and prints a warning if an error occurred.  This function always
 returns 1 on Win9X.
 
 =item Win32::IsWinNT()