/
usww.pm
129 lines (85 loc) · 2.72 KB
/
usww.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
package usww;
use 5.012005;
our $VERSION = "0.07";
use Encode qw(is_utf8 encode_utf8 decode_utf8);
use utf8();
use strict();
use warnings();
use List::Util qw(first);
sub import {
warn "it seems this is NOT a Windows\n" unless $^O eq "MSWin32";
utf8->import;
strict->import;
warnings->import( 'all', FATAL => 'recursion' );
my $cp = eval { require Win32; return Win32::GetConsoleCP() }
or die "install 'Win32' module before use it\n";
my $encoding = $@ ? 'UTF-8' : "cp$cp";
$| = 1; # is this irrelevant?
binmode \*STDIN, ":encoding($encoding)";
binmode \*STDOUT, ":encoding($encoding)";
binmode \*STDERR, ":encoding($encoding)";
$SIG{__WARN__} = \&_redecode;
$SIG{__DIE__} = sub { die _redecode(@_) };
return;
}
sub _redecode {
$_[0] =~ /^(.+) at (.+) line (\d+)\.$/;
my @texts = split $2, $_[0];
return is_utf8($1)
? $texts[0] . decode_utf8 $2. $texts[1]
: decode_utf8 $_[0];
}
1;
__END__
=encoding utf-8
=head1 NAME
usww - Forked from usw especially for Windows.
=head1 SYNOPSIS
use usww; # is just 9 bytes pragma instead of below:
use utf8;
use strict;
use warnings;
my $cp = '__YourCP__' || 'UTF-8';
binmode \*STDIN, ':encoding($cp)';
binmode \*STDOUT, ':encoding($cp)';
binmode \*STDERR, ':encoding($cp)';
=head1 DESCRIPTION
usww is C<usw> for Windows.
May be useful for those who write the above code every single time with Windows.
=head2 HOW TO USE
use usww;
It seems a kind of pragmas but doesn't spent
L<%^H|https://metacpan.org/pod/perlpragma#Key-naming>
because overusing it is nonsense.
C<use usww;> should be just the very shortcut at beginning of your codes
Therefore, if you want to set C<no>, you should do it the same way as before.
no strict;
no warnings;
no utf8;
These still work as expected everywhere.
And writing like this doesn't work
no usww;
=head2 Automatically repairs bugs around file path which is encoded
It replaces C<$SIG{__WARN__}> or/and C<$SIG{__DIE__}>
to avoid the bug(This may be a strange specification)
of encoding only the file path like that:
宣言あり at t/script/00_è¦åãã.pl line 19.
=head2 features
Since version 0.07, you can relate automatically
C<STDIN>,C<STDOUT>,C<STDERR> with C<cp\d+>
which is detected by L<Win32> module;
=head1 SEE ALSO
=over
=item L<usw> - base implement for UNIX-like OS
=item L<Encode>
=item L<binmode|https://perldoc.perl.org/functions/binmode>
=item L<%SIG|https://perldoc.perl.org/variables/%25SIG>
=item L<Win32>
=back
=head1 LICENSE
Copyright (C) worthmine.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Yuki Yoshida(L<worthmine|https://github.com/worthmine>)
=cut