The attached patch (against Win32-0.44) adds interfaces to GetACP() and
GetOEMCP().
However, they actually return information about the operating system
defaults, so GetOEMCP() doesn't get the correct value of a Command
Prompt's code page if you've changed it from its initial default value
using (e.g.) "mode con cp select=...". The patch therefore adds
GetConsoleCP() and GetConsoleOutputCP() as well. The latter is what you
need to correctly get the current console's output code page.
The patch also adds SetConsoleCP() and SetConsoleOutputCP(), since they
can be very useful too. For example, in the core perl t/op/magic.t
script, which started all this for me, it is now possible to set the
console's output code page to match perl's code page (the Windows ANSI
code page) and thus avoid the need to convert the encoding of data read
from the console (which was originally going to be my approach).
diff -ruN Win32-0.44.orig/Changes Win32-0.44/Changes
--- Win32-0.44.orig/Changes 2011-01-12 21:03:52.000000000 +0000
+++ Win32-0.44/Changes 2012-08-07 14:01:08.089202700 +0100
@@ -1,5 +1,10 @@
Revision history for the Perl extension Win32.
+0.45 [2012-08-07]
+ - add Win32::GetACP(), Win32::GetConsoleCP(),
+ Win32::GetConsoleOutputCP(), Win32::GetOEMCP(), Win32::SetConsoleCP()
+ and Win32::SetConsoleOutputCP(). [rt#78820]
+
0.44 [2011-01-12]
- fix memory leak introduced in 0.43
diff -ruN Win32-0.44.orig/MANIFEST Win32-0.44/MANIFEST
--- Win32-0.44.orig/MANIFEST 2009-01-20 02:13:42.000000000 +0000
+++ Win32-0.44/MANIFEST 2012-08-07 14:09:15.561702700 +0100
@@ -6,6 +6,7 @@
Win32.pm
Win32.xs
longpath.inc
+t/CodePage.t
t/CreateFile.t
t/ExpandEnvironmentStrings.t
t/GetCurrentThreadId.t
diff -ruN Win32-0.44.orig/META.yml Win32-0.44/META.yml
--- Win32-0.44.orig/META.yml 2011-01-12 21:03:58.000000000 +0000
+++ Win32-0.44/META.yml 2012-08-07 13:15:39.686426200 +0100
@@ -1,7 +1,7 @@
--- #YAML:1.0
name: Win32
abstract: Interfaces to some Win32 API Functions
-version: 0.44
+version: 0.45
author:
- Jan Dubois <jand@activestate.com>
license: perl
diff -ruN Win32-0.44.orig/Win32.pm Win32-0.44/Win32.pm
--- Win32-0.44.orig/Win32.pm 2011-01-12 21:04:12.000000000 +0000
+++ Win32-0.44/Win32.pm 2012-08-07 14:28:07.402202700 +0100
@@ -8,7 +8,7 @@
require DynaLoader;
@ISA = qw|Exporter DynaLoader|;
- $VERSION = '0.44';
+ $VERSION = '0.45';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -686,6 +686,11 @@
no longer valid after this call. See L<LoadLibrary|Win32::LoadLibrary(LIBNAME)>
for information on dynamically loading a library.
+=item Win32::GetACP()
+
+Returns the current Windows ANSI code page identifier for the operating
+system. See also GetOEMCP(), GetConsoleCP() and GetConsoleOutputCP().
+
=item Win32::GetANSIPathName(FILENAME)
Returns an ANSI version of FILENAME. This may be the short name
@@ -712,6 +717,20 @@
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::GetConsoleCP()
+
+Returns the input code page used by the console associated with the
+calling process. To set the console's input code page, see
+SetConsoleCP(). See also GetConsoleOutputCP(), GetACP() and
+GetOEMCP().
+
+=item Win32::GetConsoleOutputCP()
+
+Returns the output code page used by the console associated with the
+calling process. To set the console's output code page, see
+SetConsoleOutputCP(). See also GetConsoleCP(), GetACP(), and
+GetOEMCP().
+
=item Win32::GetCwd()
[CORE] Returns the current active drive and directory. This function
@@ -848,6 +867,12 @@
[CORE] Returns a string in the form of "<d>:" where <d> is the first
available drive letter.
+=item Win32::GetOEMCP()
+
+Returns the current original equipment manufacturer (OEM) code page
+identifier for the operating system. See also GetACP(), GetConsoleCP()
+and GetConsoleOutputCP().
+
=item Win32::GetOSDisplayName()
Returns the "marketing" name of the Windows operating system version
@@ -1167,6 +1192,20 @@
(but not exported) from the Win32 module: SW_HIDE, SW_SHOWNORMAL,
SW_SHOWMINIMIZED, SW_SHOWMAXIMIZED and SW_SHOWNOACTIVATE.
+=item Win32::SetConsoleCP(ID)
+
+Sets the input code page used by the console associated with the
+calling process. The return value of SetConsoleCP() is nonzero on
+success or zero on failure. To get the console's input code page, see
+GetConsoleCP().
+
+=item Win32::SetConsoleOutputCP(ID)
+
+Sets the output code page used by the console associated with the
+calling process. The return value of SetConsoleOutputCP() is nonzero on
+success or zero on failure. To get the console's output code page, see
+GetConsoleOutputCP().
+
=item Win32::SetCwd(NEWDIRECTORY)
[CORE] Sets the current active drive and directory. This function does not
diff -ruN Win32-0.44.orig/Win32.xs Win32-0.44/Win32.xs
--- Win32-0.44.orig/Win32.xs 2011-01-12 20:59:56.000000000 +0000
+++ Win32-0.44/Win32.xs 2012-08-07 14:08:34.149202700 +0100
@@ -1705,6 +1705,54 @@
XSRETURN_IV(0);
}
+XS(w32_GetACP)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(GetACP());
+}
+
+XS(w32_GetConsoleCP)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(GetConsoleCP());
+}
+
+XS(w32_GetConsoleOutputCP)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(GetConsoleOutputCP());
+}
+
+XS(w32_GetOEMCP)
+{
+ dXSARGS;
+ EXTEND(SP,1);
+ XSRETURN_IV(GetOEMCP());
+}
+
+XS(w32_SetConsoleCP)
+{
+ dXSARGS;
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::SetConsoleCP($id)");
+
+ XSRETURN_IV(SetConsoleCP((int)SvIV(ST(0))));
+}
+
+XS(w32_SetConsoleOutputCP)
+{
+ dXSARGS;
+
+ if (items != 1)
+ Perl_croak(aTHX_ "usage: Win32::SetConsoleOutputCP($id)");
+
+ XSRETURN_IV(SetConsoleOutputCP((int)SvIV(ST(0))));
+}
+
MODULE = Win32 PACKAGE = Win32
PROTOTYPES: DISABLE
@@ -1768,6 +1816,12 @@
newXS("Win32::CreateFile", w32_CreateFile, file);
newXS("Win32::GetSystemMetrics", w32_GetSystemMetrics, file);
newXS("Win32::GetProductInfo", w32_GetProductInfo, file);
+ newXS("Win32::GetACP", w32_GetACP, file);
+ newXS("Win32::GetConsoleCP", w32_GetConsoleCP, file);
+ newXS("Win32::GetConsoleOutputCP", w32_GetConsoleOutputCP, file);
+ newXS("Win32::GetOEMCP", w32_GetOEMCP, file);
+ newXS("Win32::SetConsoleCP", w32_SetConsoleCP, file);
+ newXS("Win32::SetConsoleOutputCP", w32_SetConsoleOutputCP, file);
#ifdef __CYGWIN__
newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
#endif
diff -ruN Win32-0.44.orig/t/CodePage.t Win32-0.44/t/CodePage.t
--- Win32-0.44.orig/t/CodePage.t 1970-01-01 00:00:00.000000000 +0000
+++ Win32-0.44/t/CodePage.t 2012-08-07 14:22:10.789702700 +0100
@@ -0,0 +1,27 @@
+use strict;
+use Test;
+use Win32;
+
+plan tests => 8;
+
+my $ansicp = Win32::GetACP();
+ok($ansicp > 0 && $ansicp <= 65001);
+
+my $inputcp = Win32::GetConsoleCP();
+ok($inputcp > 0 && $inputcp <= 65001);
+
+my $outputcp = Win32::GetConsoleOutputCP();
+ok($outputcp > 0 && $outputcp <= 65001);
+
+my $oemcp = Win32::GetOEMCP();
+ok($oemcp > 0 && $oemcp <= 65001);
+
+ok(Win32::SetConsoleCP($ansicp));
+ok(Win32::GetConsoleCP() == $ansicp);
+
+ok(Win32::SetConsoleOutputCP($ansicp));
+ok(Win32::GetConsoleOutputCP() == $ansicp);
+
+# Reset things when we're done.
+Win32::SetConsoleCP($inputcp);
+Win32::SetConsoleOutputCP($outputcp);
