| Current File : //usr/sbin/update-locale |
#! /usr/bin/perl -w
use strict;
use Getopt::Long;
my $progname = "update-locale";
my $locale_file = "/etc/default/locale";
my $help = 0;
my $reset = 0;
# Kept for compatibility reasons
my $remove = 0;
my $no_checks = 0;
GetOptions(
'reset' => \$reset,
'remove' => \$remove,
'locale-file=s' => \$locale_file,
'no-checks' => \$no_checks,
'h|help' => \$help,
);
sub usage
{
my $rc = shift;
print STDERR "Usage: $progname [OPTIONS] [LANG=locale] [LC_NUMERIC=locale] ...
Options:
--help display this message and exit
--reset ignore variables defined in the locale file
--locale-file=FILE file containing locale variables
(Default: /etc/default/locale)
--no-checks do not perform sanity checks on locale variables
";
exit $rc;
}
$help && usage(0);
# Process command-line arguments
my %arg = ();
my $content = '';
my $mode = 0644;
if (-r $locale_file)
{
# Keep file mode
$mode = (stat($locale_file))[2] & 07777;
# Read current values
open(IN, "<", $locale_file)
or die "$progname: Unable to read $locale_file: $!\n";
while (<IN>)
{
$content .= $_;
next unless m/^(\w+)=(.*)/;
$arg{$1} = $2 unless $reset;
}
close(IN)
or die "$progname: Unable to close $locale_file: $!\n";
$content =~ s/^(\s*\w+=)/#$1/mg;
$content .= "\n" unless $content =~ m/\n$/s;
}
else
{
$content = "# File generated by $progname\n";
}
for (@ARGV)
{
if (m/(\w+)=(.*)/)
{
$arg{$1} = $2;
}
else
{
delete $arg{$_};
}
}
my $env = '';
my ($key, $value);
while (($key, $value) = each %arg)
{
$env .= " $key=$value";
$content =~ s/^#\s*$key=.*/$key=$value/m or
$content .= "$key=$value\n";
}
# Sanity checks
if ($no_checks == 0)
{
# Check that this locale does exist
my $charset = `LANG= LC_CTYPE= LC_NUMERIC= LC_TIME= LC_COLLATE= LC_MONETARY= LC_MESSAGES= LC_PAPER= LC_NAME= LC_ADDRESS= LC_TELEPHONE= LC_MEASUREMENT= LC_IDENTIFICATION= LC_ALL= $env locale charmap 2>&1`;
die "*** $progname: Error: invalid locale settings: $env\n"
if ($charset =~ m/Cannot set/);
# If LANGUAGE is set, its first value must be compatible with LC_MESSAGES
if (defined $arg{LANGUAGE})
{
my $language = $arg{LANGUAGE};
$language =~ s/["']//g;
$language =~ s/[.:_].*//;
my $msg = '';
my $var = '';
for (qw(LANG LC_MESSAGES LC_ALL))
{
if (defined $arg{$_})
{
$var = $_;
$msg = $arg{$_};
}
}
$msg =~ s/["']//g;
if ($msg !~ m/^$language/ && $var ne ''
&& $msg ne 'C' && $msg ne 'POSIX'
&& $language ne 'C' && $language ne 'POSIX')
{
print "*** $progname: Warning: LANGUAGE ($arg{LANGUAGE}) is not compatible with $var ($msg). Disabling it.\n";
$content =~ s/^(\s*LANGUAGE=)/#$1/mg;
}
}
}
# Write locale file
open(OUT, ">", $locale_file)
or die "$progname: Unable to write $locale_file: $!\n";
print OUT $content;
close(OUT)
or die "$progname: Unable to close $locale_file: $!\n";
chmod($mode, $locale_file)
or die "$progname: Unable to chmod $locale_file: $!\n";
1;