@@ -25,31 +25,60 @@ sub _init {
2525 unless ($ENCODING_LOCALE ) {
2626 # Try to obtain what the Windows ANSI code page is
2727 eval {
28- unless (defined &GetACP) {
28+ unless (defined &GetConsoleCP) {
29+ require Win32;
30+ # no point falling back to Win32::GetConsoleCP from this
31+ # as added same time, 0.45
32+ eval { Win32::GetConsoleCP() };
33+ # manually "import" it since Win32->import refuses
34+ *GetConsoleCP = sub { &Win32::GetConsoleCP } unless $@ ;
35+ }
36+ unless (defined &GetConsoleCP) {
2937 require Win32::API;
30- Win32::API-> Import(' kernel32' , ' int GetACP ()' );
31- };
32- if (defined &GetACP ) {
33- my $cp = GetACP ();
38+ Win32::API-> Import(' kernel32' , ' int GetConsoleCP ()' );
39+ }
40+ if (defined &GetConsoleCP ) {
41+ my $cp = GetConsoleCP ();
3442 $ENCODING_LOCALE = " cp$cp " if $cp ;
3543 }
3644 };
3745 }
3846
3947 unless ($ENCODING_CONSOLE_IN ) {
40- # If we have the Win32::Console module installed we can ask
41- # it for the code set to use
42- eval {
43- require Win32::Console;
44- my $cp = Win32::Console::InputCP();
45- $ENCODING_CONSOLE_IN = " cp$cp " if $cp ;
46- $cp = Win32::Console::OutputCP();
47- $ENCODING_CONSOLE_OUT = " cp$cp " if $cp ;
48- };
49- # Invoking the 'chcp' program might also work
50- if (!$ENCODING_CONSOLE_IN && (qx( chcp) || ' ' ) =~ / ^Active code page: (\d +)/ ) {
51- $ENCODING_CONSOLE_IN = " cp$1 " ;
48+ # only test one since set together
49+ unless (defined &GetInputCP) {
50+ eval {
51+ require Win32;
52+ eval { Win32::GetConsoleCP() };
53+ # manually "import" it since Win32->import refuses
54+ *GetInputCP = sub { &Win32::GetConsoleCP } unless $@ ;
55+ *GetOutputCP = sub { &Win32::GetConsoleOutputCP } unless $@ ;
56+ };
57+ unless (defined &GetInputCP) {
58+ eval {
59+ # try Win32::Console module for codepage to use
60+ require Win32::Console;
61+ eval { Win32::Console::InputCP() };
62+ *GetInputCP = sub { &Win32::Console::InputCP }
63+ unless $@ ;
64+ *GetOutputCP = sub { &Win32::Console::OutputCP }
65+ unless $@ ;
66+ };
67+ }
68+ unless (defined &GetInputCP) {
69+ # final fallback
70+ *GetInputCP = *GetOutputCP = sub {
71+ # another fallback that could work is:
72+ # reg query HKLM\System\CurrentControlSet\Control\Nls\CodePage /v ACP
73+ ((qx( chcp) || ' ' ) =~ / ^Active code page: (\d +)/ )
74+ ? $1 : ();
75+ };
76+ }
5277 }
78+ my $cp = GetInputCP();
79+ $ENCODING_CONSOLE_IN = " cp$cp " if $cp ;
80+ $cp = GetOutputCP();
81+ $ENCODING_CONSOLE_OUT = " cp$cp " if $cp ;
5382 }
5483 }
5584
@@ -206,8 +235,7 @@ C<Encode::Locale> will do that if available and make these encodings known
206235under the C<Encode > aliases "console_in" and "console_out". For systems where
207236we can't determine the terminal encoding these will be aliased as the same
208237encoding as "locale". The advice is to use "console_in" for input known to
209- come from the terminal and "console_out" for output known to go from the
210- terminal.
238+ come from the terminal and "console_out" for output to the terminal.
211239
212240In addition to arranging for various Encode aliases the following functions and
213241variables are provided:
@@ -266,7 +294,7 @@ L<Encode> know this encoding as "locale".
266294
267295=item $ENCODING_LOCALE_FS
268296
269- The encoding name determined to be suiteable for file system interfaces
297+ The encoding name determined to be suitable for file system interfaces
270298involving file names.
271299L<Encode> know this encoding as "locale_fs".
272300
@@ -336,7 +364,7 @@ Users are advised to always specify UTF-8 as the locale charset.
336364
337365=head1 SEE ALSO
338366
339- L<I18N::Langinfo> , L<Encode>
367+ L<I18N::Langinfo> , L<Encode> , L<Term::Encoding>
340368
341369=head1 AUTHOR
342370
0 commit comments