line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# -*- perl -*- |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Author: Slaven Rezic |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Copyright (C) 2017,2018,2020 Slaven Rezic. All rights reserved. |
7
|
|
|
|
|
|
|
# This package is free software; you can redistribute it and/or |
8
|
|
|
|
|
|
|
# modify it under the same terms as Perl itself. |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# Mail: slaven@rezic.de |
11
|
|
|
|
|
|
|
# WWW: http://www.rezic.de/eserte/ |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
package Doit::Locale; |
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
26
|
|
17
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
33
|
|
18
|
|
|
|
|
|
|
our $VERSION = '0.024'; |
19
|
|
|
|
|
|
|
|
20
|
1
|
|
|
1
|
|
5
|
use Doit::Log; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
663
|
|
21
|
|
|
|
|
|
|
|
22
|
1
|
|
|
1
|
0
|
8
|
sub new { bless {}, shift } |
23
|
1
|
|
|
1
|
0
|
3
|
sub functions { qw(locale_enable_locale) } |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub locale_enable_locale { |
26
|
0
|
|
|
0
|
0
|
|
my($self, $locale) = @_; |
27
|
0
|
|
|
|
|
|
my %locale; |
28
|
0
|
0
|
|
|
|
|
if (ref $locale eq 'ARRAY') { |
29
|
0
|
|
|
|
|
|
%locale = map{($_,1)} @$locale; |
|
0
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
} else { |
31
|
0
|
|
|
|
|
|
%locale = ($locale => 1); |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
###################################################################### |
35
|
|
|
|
|
|
|
# Is locale already present? |
36
|
|
|
|
|
|
|
my $is_locale_present = sub { |
37
|
0
|
0
|
|
0
|
|
|
open my $fh, '-|', 'locale', '-a' |
38
|
|
|
|
|
|
|
or error "Error while running 'locale -a': $!"; |
39
|
0
|
|
|
|
|
|
while(<$fh>) { |
40
|
0
|
|
|
|
|
|
chomp; |
41
|
0
|
0
|
|
|
|
|
if ($locale{$_}) { |
42
|
0
|
|
|
|
|
|
return 1; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
} |
45
|
0
|
0
|
|
|
|
|
close $fh |
46
|
|
|
|
|
|
|
or error "Error while running 'locale -a': $!"; |
47
|
0
|
|
|
|
|
|
return 0; |
48
|
0
|
|
|
|
|
|
}; |
49
|
|
|
|
|
|
|
|
50
|
0
|
0
|
|
|
|
|
if ($is_locale_present->()) { |
51
|
0
|
|
|
|
|
|
return 0; # no change |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
###################################################################### |
55
|
|
|
|
|
|
|
# locale-gen (e.g. Ubuntu 12.03) |
56
|
0
|
0
|
0
|
|
|
|
if (-x "/usr/sbin/locale-gen" && !-e "/etc/locale.gen") { |
57
|
0
|
|
|
|
|
|
$self->system('locale-gen', $locale->[0]); |
58
|
0
|
|
|
|
|
|
return 1; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
###################################################################### |
62
|
|
|
|
|
|
|
# /etc/locale.gen (e.g. Debian and Debian-like) |
63
|
0
|
0
|
|
|
|
|
if (-e "/etc/locale.gen") { |
64
|
0
|
|
|
|
|
|
my $all_locales = '(' . join('|', map { quotemeta $_ } keys %locale) . ')'; |
|
0
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my $changes = $self->change_file("/etc/locale.gen", |
66
|
|
|
|
|
|
|
{match => qr{^#\s+$all_locales(\s|$)}, |
67
|
0
|
|
|
0
|
|
|
action => sub { $_[0] =~ s{^#\s+}{}; }, |
68
|
|
|
|
|
|
|
}, |
69
|
0
|
|
|
|
|
|
); |
70
|
0
|
0
|
|
|
|
|
if (!$changes) { |
71
|
0
|
|
|
|
|
|
error "Cannot find prepared locale '$locale' in /etc/locale.gen"; |
72
|
|
|
|
|
|
|
} |
73
|
0
|
|
|
|
|
|
$self->system('locale-gen'); |
74
|
0
|
|
|
|
|
|
return 1; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
###################################################################### |
78
|
|
|
|
|
|
|
# localedef (e.g RedHat, CentOS) |
79
|
0
|
0
|
0
|
|
|
|
if (-x "/usr/bin/localedef" && -e "/etc/redhat-release") { |
80
|
|
|
|
|
|
|
# It also exists on Debian-based systems, but works differently there. |
81
|
0
|
|
|
|
|
|
my $use_glibc_langpack; |
82
|
0
|
0
|
|
|
|
|
if (open my $fh, "/etc/redhat-release") { |
83
|
0
|
|
|
|
|
|
my $line = <$fh>; |
84
|
0
|
0
|
0
|
|
|
|
if ( |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
85
|
|
|
|
|
|
|
($line =~ /^Fedora release (\d+) / && $1 >= 28) # XXX since when we should take this path? |
86
|
|
|
|
|
|
|
|| ($line =~ /^CentOS Linux release (\d+)/ && $1 >= 8) |
87
|
|
|
|
|
|
|
) { |
88
|
0
|
|
|
|
|
|
$use_glibc_langpack = 1; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
TRY_LOCALE: { |
92
|
0
|
|
|
|
|
|
my @errors; |
|
0
|
|
|
|
|
|
|
93
|
0
|
0
|
|
|
|
|
if ($use_glibc_langpack) { |
94
|
0
|
0
|
|
|
|
|
if ((keys(%locale))[0] =~ m{^([^_]+)}) { |
95
|
0
|
|
|
|
|
|
my $lang = $1; |
96
|
|
|
|
|
|
|
# XXX requires a previous add_component("rpm"); should be done automatically! |
97
|
0
|
|
|
|
|
|
my $package = 'glibc-langpack-'.$lang; |
98
|
0
|
|
|
|
|
|
eval { $self->rpm_install_packages($package) }; |
|
0
|
|
|
|
|
|
|
99
|
0
|
0
|
|
|
|
|
if (!$@) { |
100
|
0
|
|
|
|
|
|
last TRY_LOCALE; |
101
|
|
|
|
|
|
|
} |
102
|
0
|
|
|
|
|
|
push @errors, "Installing $package failed: $@"; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
} |
105
|
0
|
|
|
|
|
|
for my $try_locale (sort keys %locale) { |
106
|
0
|
0
|
|
|
|
|
if (my($lang_country, $charset) = $try_locale =~ m{^(.*)\.(.*)$}) { |
107
|
0
|
|
|
|
|
|
my $stderr; |
108
|
0
|
|
|
|
|
|
eval { $self->open3({errref => \$stderr}, '/usr/bin/localedef', '-c', '-i', $lang_country, '-f', $charset, $try_locale) }; |
|
0
|
|
|
|
|
|
|
109
|
0
|
0
|
|
|
|
|
if (!$@) { |
110
|
0
|
|
|
|
|
|
last TRY_LOCALE; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
# an error, but maybe successful? |
113
|
0
|
0
|
|
|
|
|
if ($is_locale_present->()) { |
114
|
0
|
|
|
|
|
|
last TRY_LOCALE; |
115
|
|
|
|
|
|
|
} |
116
|
0
|
|
|
|
|
|
push @errors, "Can't add '$try_locale': $stderr"; |
117
|
|
|
|
|
|
|
} else { |
118
|
0
|
|
|
|
|
|
push @errors, "Can't parse '$try_locale' as lang_COUNTRY.charset"; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
} |
121
|
0
|
|
|
|
|
|
error "Can't install locale. Errors:\n" . join("\n", @errors); |
122
|
|
|
|
|
|
|
} |
123
|
0
|
|
|
|
|
|
return 1; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
###################################################################### |
127
|
|
|
|
|
|
|
# not implemented elsewhere |
128
|
0
|
|
|
|
|
|
error "Don't know how to enable locales on this system"; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
1; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
__END__ |