X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FLocale.pm;h=3b91502d5e2f990e11497512768396787f1572a4;hb=43816cb7289ee9225c3bb229d077bd87a75562cc;hp=1e41344552f1247a2e709421f7c4d7e96a9fbbfa;hpb=dc3cd296e62eb09a16fa694d9b3a7158e4cf63bf;p=kivitendo-erp.git diff --git a/SL/Locale.pm b/SL/Locale.pm index 1e4134455..3b91502d5 100644 --- a/SL/Locale.pm +++ b/SL/Locale.pm @@ -27,7 +27,8 @@ # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +# MA 02110-1335, USA. #====================================================================== # # Translations and number/date formatting @@ -36,65 +37,91 @@ package Locale; -use Text::Iconv; +use DateTime; +use Encode; +use List::Util qw(first); +use List::MoreUtils qw(any); use SL::LXDebug; use SL::Common; +use SL::Iconv; use SL::Inifile; +use strict; + +my %locales_by_country; + sub new { $main::lxdebug->enter_sub(); - my ($type, $country, $NLS_file) = @_; + my ($type, $country) = @_; - my $self = {}; - bless $self, $type; + $country ||= $::lx_office_conf{system}->{language}; + $country =~ s|.*/||; + $country =~ s|\.||g; - $country =~ s|.*/||; - $country =~ s|\.||g; - $NLS_file =~ s|.*/||; + if (!$locales_by_country{$country}) { + my $self = {}; + bless $self, $type; - $self->_init($country, $NLS_file); + $self->_init($country); + + $locales_by_country{$country} = $self; + } $main::lxdebug->leave_sub(); - return $self; + return $locales_by_country{$country} +} + +sub is_supported { + my ($country) = @_; + + return -f "locale/$country/all"; } sub _init { my $self = shift; my $country = shift; - my $NLS_file = shift; + + $self->{countrycode} = $country; if ($country && -d "locale/$country") { - local *IN; - $self->{countrycode} = $country; - if (open(IN, "<", "locale/$country/$NLS_file")) { - my $code = join("", ); + if (open my $in, "<", "locale/$country/all") { + local $/ = undef; + my $code = <$in>; eval($code); - close(IN); + close($in); } - if (open IN, "<", "locale/$country/charset") { - $self->{charset} = ; - close IN; - - chomp $self->{charset}; - - } else { - $self->{charset} = Common::DEFAULT_CHARSET; + if (-d "locale/$country/more") { + opendir my $dh, "locale/$country/more" or die "can't open locale/$country/more: $!"; + my @files = sort grep -f "locale/$country/more/$_", readdir $dh; + close $dh; + + for my $file (@files) { + if (open my $in, "<", "locale/$country/more/$file") { + local $/ = undef; + my $code = <$in>; + eval($code); + close($in); + $self->{texts}{$_} = $self->{more_texts}{$_} for keys %{ $self->{more_texts} }; + } + } } + } - $self->_read_special_chars_file($country); + binmode STDOUT, ":utf8"; + binmode STDERR, ":utf8"; - my $db_charset = $main::dbcharset || Common::DEFAULT_CHARSET; + $self->{iconv} = SL::Iconv->new('UTF-8', 'UTF-8'); + $self->{iconv_reverse} = SL::Iconv->new('UTF-8', 'UTF-8'); + $self->{iconv_english} = SL::Iconv->new('ASCII', 'UTF-8'); + $self->{iconv_iso8859} = SL::Iconv->new('ISO-8859-15', 'UTF-8'); + $self->{iconv_to_iso8859} = SL::Iconv->new('UTF-8', 'ISO-8859-15'); + $self->{iconv_utf8} = SL::Iconv->new('UTF-8', 'UTF-8'); - $self->{iconv} = Text::Iconv->new($self->{charset}, $db_charset); - $self->{iconv_english} = Text::Iconv->new('ASCII', $db_charset); - $self->{iconv_iso8859} = Text::Iconv->new('ISO-8859-15', $db_charset); - } - - $self->{NLS_file} = $NLS_file; + $self->_read_special_chars_file($country); push @{ $self->{LONG_MONTH} }, ("January", "February", "March", "April", @@ -105,19 +132,44 @@ sub _init { } sub _handle_markup { - my $self = shift; - my $str = shift; + my $self = shift; + my $str = shift; - if ($str eq "\\n") { - return "\n"; - } elsif ($str eq "\\r") { - return "\r"; - } + my $escaped = 0; + my $new_str = ''; + + for (my $i = 0; $i < length $str; $i++) { + my $char = substr $str, $i, 1; + + if ($escaped) { + if ($char eq 'n') { + $new_str .= "\n"; + + } elsif ($char eq 'r') { + $new_str .= "\r"; + + } elsif ($char eq 's') { + $new_str .= ' '; + + } elsif ($char eq 'x') { + $new_str .= chr(hex(substr($str, $i + 1, 2))); + $i += 2; + + } else { + $new_str .= $char; + } + + $escaped = 0; - $str =~ s/\\x(..)/chr(hex($1))/eg; - $str =~ s/\\(.)/$1/g; + } elsif ($char eq '\\') { + $escaped = 1; - return $str; + } else { + $new_str .= $char; + } + } + + return $new_str; } sub _read_special_chars_file { @@ -141,13 +193,13 @@ sub _read_special_chars_file { } my $scmap = $self->{special_chars_map}->{$format}; - my $order = $scmap->{order}; + my $order = $self->{iconv}->convert($scmap->{order}); delete $scmap->{order}; foreach my $key (keys %{ $scmap }) { - $scmap->{$key} = $self->_handle_markup($scmap->{$key}); + $scmap->{$key} = $self->_handle_markup($self->{iconv}->convert($scmap->{$key})); - my $new_key = $self->_handle_markup($key); + my $new_key = $self->_handle_markup($self->{iconv}->convert($key)); if ($key ne $new_key) { $scmap->{$new_key} = $scmap->{$key}; @@ -166,7 +218,9 @@ sub text { my $self = shift; my $text = shift; - if (exists $self->{texts}->{$text}) { + return $text->translated if (ref($text) || '') eq 'SL::Locale::String'; + + if ($self->{texts}->{$text}) { $text = $self->{iconv}->convert($self->{texts}->{$text}); } else { $text = $self->{iconv_english}->convert($text); @@ -179,23 +233,49 @@ sub text { return $text; } +sub lang_to_locale { + my ($self, $requested_lang) = @_; + + my $requested_locale; + $requested_locale = 'de' if $requested_lang =~ m/^_(de|deu|ger)/i; + $requested_locale = 'en' if $requested_lang =~ m/^_(en|uk|us|gr)/i; + $requested_locale = 'fr' if $requested_lang =~ m/^_fr/i; + $requested_locale ||= 'de'; + + return $requested_locale; +} + sub findsub { $main::lxdebug->enter_sub(); my ($self, $text) = @_; + my $text_rev = lc $self->{iconv_reverse}->convert($text); + $text_rev =~ s/[\s\-]+/_/g; - if (exists $self->{subs}{$text}) { - $text = $self->{subs}{$text}; - } else { - if ($self->{countrycode} && $self->{NLS_file}) { - Form->error( - "$text not defined in locale/$self->{countrycode}/$self->{NLS_file}"); + if (!$self->{texts_reverse}) { + $self->{texts_reverse} = { }; + while (my ($original, $translation) = each %{ $self->{texts} }) { + $original = lc $original; + $original =~ s/[^a-z0-9]/_/g; + $original =~ s/_+/_/g; + + $translation = lc $translation; + $translation =~ s/[\s\-]+/_/g; + + $self->{texts_reverse}->{$translation} ||= [ ]; + push @{ $self->{texts_reverse}->{$translation} }, $original; } } + my $sub_name; + $sub_name = first { defined(&{ "::${_}" }) } @{ $self->{texts_reverse}->{$text_rev} } if $self->{texts_reverse}->{$text_rev}; + $sub_name ||= $text_rev if ($text_rev =~ m/^[a-z][a-z0-9_]+$/) && defined &{ "::${text_rev}" }; + + $main::form->error("$text not defined in locale/$self->{countrycode}/all") if !$sub_name; + $main::lxdebug->leave_sub(); - return $text; + return $sub_name; } sub date { @@ -203,71 +283,74 @@ sub date { my ($self, $myconfig, $date, $longformat) = @_; + if (!$date) { + $main::lxdebug->leave_sub(); + return ''; + } + my $longdate = ""; my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH'; - if ($date) { + my ($spc, $yy, $mm, $dd); # get separator - $spc = $myconfig->{dateformat}; - $spc =~ s/\w//g; - $spc = substr($spc, 1, 1); + $spc = $myconfig->{dateformat}; + $spc =~ s/\w//g; + $spc = substr($spc, 1, 1); - if ($date =~ /\D/) { - if ($myconfig->{dateformat} =~ /^yy/) { - ($yy, $mm, $dd) = split /\D/, $date; - } - if ($myconfig->{dateformat} =~ /^mm/) { - ($mm, $dd, $yy) = split /\D/, $date; - } - if ($myconfig->{dateformat} =~ /^dd/) { - ($dd, $mm, $yy) = split /\D/, $date; - } - } else { - $date = substr($date, 2); - ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/); + if ($date =~ /\D/) { + if ($myconfig->{dateformat} =~ /^yy/) { + ($yy, $mm, $dd) = split /\D/, $date; + } + if ($myconfig->{dateformat} =~ /^mm/) { + ($mm, $dd, $yy) = split /\D/, $date; } + if ($myconfig->{dateformat} =~ /^dd/) { + ($dd, $mm, $yy) = split /\D/, $date; + } + } else { + $date = substr($date, 2); + ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/); + } - $dd *= 1; - $mm--; - $yy = ($yy < 70) ? $yy + 2000 : $yy; - $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy; + $dd *= 1; + $mm--; + $yy = ($yy < 70) ? $yy + 2000 : $yy; + $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy; - if ($myconfig->{dateformat} =~ /^dd/) { - if (defined $longformat && $longformat == 0) { - $mm++; - $dd = "0$dd" if ($dd < 10); - $mm = "0$mm" if ($mm < 10); - $longdate = "$dd$spc$mm$spc$yy"; - } else { - $longdate = "$dd"; - $longdate .= ($spc eq '.') ? ". " : " "; - $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy"; - } - } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") { - - # Use German syntax with the ISO date style "yyyy-mm-dd" because - # Lx-Office is mainly used in Germany or German speaking countries. - if (defined $longformat && $longformat == 0) { - $mm++; - $dd = "0$dd" if ($dd < 10); - $mm = "0$mm" if ($mm < 10); - $longdate = "$yy-$mm-$dd"; - } else { - $longdate = "$dd. "; - $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy"; - } + if ($myconfig->{dateformat} =~ /^dd/) { + if (defined $longformat && $longformat == 0) { + $mm++; + $dd = "0$dd" if ($dd < 10); + $mm = "0$mm" if ($mm < 10); + $longdate = "$dd$spc$mm$spc$yy"; } else { - if (defined $longformat && $longformat == 0) { - $mm++; - $dd = "0$dd" if ($dd < 10); - $mm = "0$mm" if ($mm < 10); - $longdate = "$mm$spc$dd$spc$yy"; - } else { - $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy"; - } + $longdate = "$dd"; + $longdate .= ($spc eq '.') ? ". " : " "; + $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy"; + } + } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") { + + # Use German syntax with the ISO date style "yyyy-mm-dd" because + # kivitendo is mainly used in Germany or German speaking countries. + if (defined $longformat && $longformat == 0) { + $mm++; + $dd = "0$dd" if ($dd < 10); + $mm = "0$mm" if ($mm < 10); + $longdate = "$yy-$mm-$dd"; + } else { + $longdate = "$dd. "; + $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy"; + } + } else { + if (defined $longformat && $longformat == 0) { + $mm++; + $dd = "0$dd" if ($dd < 10); + $mm = "0$mm" if ($mm < 10); + $longdate = "$mm$spc$dd$spc$yy"; + } else { + $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy"; } - } $main::lxdebug->leave_sub(); @@ -276,12 +359,13 @@ sub date { } sub parse_date { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($self, $myconfig, $date, $longformat) = @_; + my ($spc, $yy, $mm, $dd); unless ($date) { - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return (); } @@ -303,44 +387,128 @@ sub parse_date { ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/); } - $dd *= 1; - $mm *= 1; + $_ ||= 0 for ($dd, $mm, $yy); + $_ *= 1 for ($dd, $mm, $yy); $yy = ($yy < 70) ? $yy + 2000 : $yy; $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy; - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return ($yy, $mm, $dd); } +sub parse_date_to_object { + my ($self, $string, %params) = @_; + + return undef if !defined $string; + + return DateTime->today_local if lc($string) eq 'today'; + return DateTime->today_local->subtract(days => 1) if lc($string) eq 'yesterday'; + + $params{dateformat} ||= $::myconfig{dateformat} || 'yy-mm-dd'; + $params{numberformat} ||= $::myconfig{numberformat} || '1,000.00'; + my $num_separator = $params{numberformat} =~ m{,\d+$} ? ',' : '.'; + + my ($date_str, $time_str) = split m{\s+}, $string, 2; + my ($yy, $mm, $dd) = $self->parse_date(\%params, $date_str); + + my ($hour, $minute, $second) = split m/:/, ($time_str || ''); + $second ||= '0'; + + ($second, my $millisecond) = split quotemeta($num_separator), $second, 2; + $_ ||= 0 for ($hour, $minute, $millisecond); + + $millisecond = substr $millisecond, 0, 3; + $millisecond .= '0' x (3 - length $millisecond); + + return undef unless $yy && $mm && $dd; + return DateTime->new(year => $yy, month => $mm, day => $dd, hour => $hour * 1, minute => $minute * 1, second => $second * 1, nanosecond => $millisecond * 1000000); +} + +sub format_date_object_to_time { + my ($self, $datetime, %params) = @_; + + my $format = $::myconfig{timeformat} || 'hh:mm'; + $format =~ s/hh/\%H/; + $format =~ s/mm/\%M/; + $format =~ s/ss/\%S/; + + return $datetime->strftime($format); +} + +sub format_date_object { + my ($self, $datetime, %params) = @_; + + my $format = $params{dateformat} || $::myconfig{dateformat} || 'yyyy-mm-dd'; + my $num_separator = ($params{numberformat} || $::myconfig{numberformat} || '1,000.00') =~ m{,\d+$} ? ',' : '.'; + $format =~ s/yy(?:yy)?/\%Y/; + $format =~ s/mm/\%m/; + $format =~ s/dd/\%d/; + + my $precision = $params{precision} || 'day'; + $precision =~ s/s$//; + my %precision_spec_map = ( + millisecond => '%H:%M:%S' . $num_separator . '%3N', + second => '%H:%M:%S', + minute => '%H:%M', + hour => '%H', + ); + + $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision}; + + return $datetime->strftime($format); +} + sub reformat_date { - $main::lxdebug->enter_sub(); + $main::lxdebug->enter_sub(2); my ($self, $myconfig, $date, $output_format, $longformat) = @_; - $main::lxdebug->leave_sub() and return "" unless ($date); + $main::lxdebug->leave_sub(2) and return "" unless ($date); my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date); - $output_format =~ /d+/; + $output_format =~ /(d+)/; substr($output_format, $-[0], $+[0] - $-[0]) = - sprintf("%0" . (length($&)) . "d", $dd); + sprintf("%0" . (length($1)) . "d", $dd); - $output_format =~ /m+/; + $output_format =~ /(m+)/; substr($output_format, $-[0], $+[0] - $-[0]) = - sprintf("%0" . (length($&)) . "d", $mm); + sprintf("%0" . (length($1)) . "d", $mm); $output_format =~ /y+/; - if (length($&) == 2) { - $yy -= $yy >= 2000 ? 2000 : 1900; - } - substr($output_format, $-[0], $+[0] - $-[0]) = - sprintf("%0" . (length($&)) . "d", $yy); + substr($output_format, $-[0], $+[0] - $-[0]) = $yy; - $main::lxdebug->leave_sub(); + $main::lxdebug->leave_sub(2); return $output_format; } +sub format_date { + $main::lxdebug->enter_sub(); + + my $self = shift; + my $myconfig = shift; + my $yy = shift; + my $mm = shift; + my $dd = shift; + my $yy_len = shift || 4; + + ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime'; + + $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd; + + $yy = $yy % 100 if 2 == $yy_len; + + my $format = ref $myconfig eq '' ? "$myconfig" : $myconfig->{dateformat}; + $format =~ s{ (d+) }{ sprintf("%0" . (length($1)) . "d", $dd) }gex; + $format =~ s{ (m+) }{ sprintf("%0" . (length($1)) . "d", $mm) }gex; + $format =~ s{ (y+) }{ sprintf("%0${yy_len}d", $yy) }gex; + + $main::lxdebug->leave_sub(); + + return $format; +} + sub quote_special_chars { my $self = shift; my $format = lc shift; @@ -370,4 +538,209 @@ sub remap_special_chars { return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift)); } +sub raw_io_active { + my $self = shift; + + return !!$self->{raw_io_active}; +} + +sub with_raw_io { + my $self = shift; + my $fh = shift; + my $code = shift; + + $self->{raw_io_active} = 1; + binmode $fh, ":raw"; + $code->(); + binmode $fh, ":utf8"; + $self->{raw_io_active} = 0; +} + +sub set_numberformat_wo_thousands_separator { + my $self = shift; + my $myconfig = shift || \%::myconfig; + + $self->{saved_numberformat} = $myconfig->{numberformat}; + $myconfig->{numberformat} =~ s/^1[,\.]/1/; +} + +sub restore_numberformat { + my $self = shift; + my $myconfig = shift || \%::myconfig; + + $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat}; +} + +sub get_local_time_zone { + my $self = shift; + $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local'); + return $self->{local_time_zone}; +} + +sub language_join { + my ($self, $items, %params) = @_; + + $items ||= []; + $params{conjunction} ||= $::locale->text('and'); + my $num = scalar @{ $items }; + + return 0 == $num ? '' + : 1 == $num ? $items->[0] + : join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1]; +} + 1; + +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +Locale - Functions for dealing with locale-dependent information + +=head1 SYNOPSIS + + use Locale; + use DateTime; + + my $locale = Locale->new('de'); + my $now = DateTime->now_local; + print "Current date and time: ", $::locale->format_date_object($now, precision => 'second'), "\n"; + +=head1 OVERVIEW + +TODO: write overview + +=head1 FUNCTIONS + +=over 4 + +=item C + +TODO: Describe date + +=item C + +TODO: Describe findsub + +=item C + +TODO: Describe format_date + +=item C + +Formats the C<$datetime> object according to the user's locale setting. + +The parameter C can control whether or not the time +component is formatted as well: + +=over 4 + +=item * C + +Only format the year, month and day. This is also the default. + +=item * C + +Add the hour to the date. + +=item * C + +Add hour:minute to the date. + +=item * C + +Add hour:minute:second to the date. + +=item * C + +Add hour:minute:second.millisecond to the date. The decimal separator +is derived from the number format. + +=item * C + +The number format to use, e.g. C<1,000.00>. If unset the user's +current number format is used. + +=item * C + +The date format to use, e.g. C. If unset the user's current +date format is used. + +=back + +=item C + +TODO: Describe get_local_time_zone + +=item C + +TODO: Describe lang_to_locale + +=item C + +TODO: Describe new + +=item C + +TODO: Describe parse_date + +=item C + +Parses a date and optional timestamp in C<$string> and returns an +instance of L. The date and number formats used are the ones +the user has currently selected. They can be overriden by passing them +in as parameters to this function, though. + +The time stamps can have up to millisecond precision. + +=item C + +TODO: Describe quote_special_chars + +=item C + +TODO: Describe raw_io_active + +=item C + +TODO: Describe reformat_date + +=item C + +TODO: Describe remap_special_chars + +=item C + +TODO: Describe restore_numberformat + +=item C + +TODO: Describe set_numberformat_wo_thousands_separator + +=item C + +TODO: Describe text + +=item C + +TODO: Describe unquote_special_chars + +=item C + +TODO: Describe with_raw_io + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE + +=cut