1 #====================================================================
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
7 #=====================================================================
8 # SQL-Ledger Accounting
9 # Copyright (C) 1998-2002
11 # Author: Dieter Simader
12 # Email: dsimader@sql-ledger.org
13 # Web: http://www.sql-ledger.org
15 # Contributors: Thomas Bayen <bayen@gmx.de>
16 # Antti Kaihola <akaihola@siba.fi>
17 # Moritz Bunkus (tex code)
19 # This program is free software; you can redistribute it and/or modify
20 # it under the terms of the GNU General Public License as published by
21 # the Free Software Foundation; either version 2 of the License, or
22 # (at your option) any later version.
24 # This program is distributed in the hope that it will be useful,
25 # but WITHOUT ANY WARRANTY; without even the implied warranty of
26 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
27 # GNU General Public License for more details.
28 # You should have received a copy of the GNU General Public License
29 # along with this program; if not, write to the Free Software
30 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
32 #======================================================================
34 # Translations and number/date formatting
36 #======================================================================
42 use List::Util qw(first);
43 use List::MoreUtils qw(any);
52 my %locales_by_country;
55 $main::lxdebug->enter_sub();
57 my ($type, $country) = @_;
59 $country ||= $::lx_office_conf{system}->{language};
63 if (!$locales_by_country{$country}) {
67 $self->_init($country);
69 $locales_by_country{$country} = $self;
72 $main::lxdebug->leave_sub();
74 return $locales_by_country{$country}
80 return -f "locale/$country/all";
87 $self->{countrycode} = $country;
89 if ($country && -d "locale/$country") {
90 if (open my $in, "<", "locale/$country/all") {
97 if (-d "locale/$country/more") {
98 opendir my $dh, "locale/$country/more" or die "can't open locale/$country/more: $!";
99 my @files = sort grep -f "locale/$country/more/$_", readdir $dh;
102 for my $file (@files) {
103 if (open my $in, "<", "locale/$country/more/$file") {
108 $self->{texts}{$_} = $self->{more_texts}{$_} for keys %{ $self->{more_texts} };
114 binmode STDOUT, ":utf8";
115 binmode STDERR, ":utf8";
117 $self->{iconv} = SL::Iconv->new('UTF-8', 'UTF-8');
118 $self->{iconv_reverse} = SL::Iconv->new('UTF-8', 'UTF-8');
119 $self->{iconv_english} = SL::Iconv->new('ASCII', 'UTF-8');
120 $self->{iconv_iso8859} = SL::Iconv->new('ISO-8859-15', 'UTF-8');
121 $self->{iconv_to_iso8859} = SL::Iconv->new('UTF-8', 'ISO-8859-15');
122 $self->{iconv_utf8} = SL::Iconv->new('UTF-8', 'UTF-8');
124 $self->_read_special_chars_file($country);
126 push @{ $self->{LONG_MONTH} },
127 ("January", "February", "March", "April",
128 "May ", "June", "July", "August",
129 "September", "October", "November", "December");
130 push @{ $self->{SHORT_MONTH} },
131 (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
141 for (my $i = 0; $i < length $str; $i++) {
142 my $char = substr $str, $i, 1;
148 } elsif ($char eq 'r') {
151 } elsif ($char eq 's') {
154 } elsif ($char eq 'x') {
155 $new_str .= chr(hex(substr($str, $i + 1, 2)));
164 } elsif ($char eq '\\') {
175 sub _read_special_chars_file {
179 if (! -f "locale/$country/special_chars") {
180 $self->{special_chars_map} = {};
184 $self->{special_chars_map} = Inifile->new("locale/$country/special_chars", 'verbatim' => 1);
186 foreach my $format (keys %{ $self->{special_chars_map} }) {
187 next if (($format eq 'FILE') || ($format eq 'ORDER') || (ref $self->{special_chars_map}->{$format} ne 'HASH'));
189 if ($format ne lc $format) {
190 $self->{special_chars_map}->{lc $format} = $self->{special_chars_map}->{$format};
191 delete $self->{special_chars_map}->{$format};
192 $format = lc $format;
195 my $scmap = $self->{special_chars_map}->{$format};
196 my $order = $self->{iconv}->convert($scmap->{order});
197 delete $scmap->{order};
199 foreach my $key (keys %{ $scmap }) {
200 $scmap->{$key} = $self->_handle_markup($self->{iconv}->convert($scmap->{$key}));
202 my $new_key = $self->_handle_markup($self->{iconv}->convert($key));
204 if ($key ne $new_key) {
205 $scmap->{$new_key} = $scmap->{$key};
206 delete $scmap->{$key};
210 $self->{special_chars_map}->{"${format}-reverse"} = { reverse %{ $scmap } };
212 $scmap->{order} = [ map { $self->_handle_markup($_) } split m/\s+/, $order ];
213 $self->{special_chars_map}->{"${format}-reverse"}->{order} = [ grep { $_ } map { $scmap->{$_} } reverse @{ $scmap->{order} } ];
221 return $text->translated if (ref($text) || '') eq 'SL::Locale::String';
223 if ($self->{texts}->{$text}) {
224 $text = $self->{iconv}->convert($self->{texts}->{$text});
226 $text = $self->{iconv_english}->convert($text);
230 $text = Form->format_string($text, @_);
237 my ($self, $requested_lang) = @_;
239 my $requested_locale;
240 $requested_locale = 'de' if $requested_lang =~ m/^_(de|deu|ger)/i;
241 $requested_locale = 'en' if $requested_lang =~ m/^_(en|uk|us|gr)/i;
242 $requested_locale = 'fr' if $requested_lang =~ m/^_fr/i;
243 $requested_locale ||= 'de';
245 return $requested_locale;
249 $main::lxdebug->enter_sub();
251 my ($self, $text) = @_;
252 my $text_rev = lc $self->{iconv_reverse}->convert($text);
253 $text_rev =~ s/[\s\-]+/_/g;
255 if (!$self->{texts_reverse}) {
256 $self->{texts_reverse} = { };
257 while (my ($original, $translation) = each %{ $self->{texts} }) {
258 $original = lc $original;
259 $original =~ s/[^a-z0-9]/_/g;
260 $original =~ s/_+/_/g;
262 $translation = lc $translation;
263 $translation =~ s/[\s\-]+/_/g;
265 $self->{texts_reverse}->{$translation} ||= [ ];
266 push @{ $self->{texts_reverse}->{$translation} }, $original;
271 $sub_name = first { defined(&{ "::${_}" }) } @{ $self->{texts_reverse}->{$text_rev} } if $self->{texts_reverse}->{$text_rev};
272 $sub_name ||= $text_rev if ($text_rev =~ m/^[a-z][a-z0-9_]+$/) && defined &{ "::${text_rev}" };
274 $main::form->error("$text not defined in locale/$self->{countrycode}/all") if !$sub_name;
276 $main::lxdebug->leave_sub();
282 $main::lxdebug->enter_sub();
284 my ($self, $myconfig, $date, $longformat) = @_;
287 $main::lxdebug->leave_sub();
292 my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
294 my ($spc, $yy, $mm, $dd);
297 $spc = $myconfig->{dateformat};
299 $spc = substr($spc, 1, 1);
302 if ($myconfig->{dateformat} =~ /^yy/) {
303 ($yy, $mm, $dd) = split /\D/, $date;
305 if ($myconfig->{dateformat} =~ /^mm/) {
306 ($mm, $dd, $yy) = split /\D/, $date;
308 if ($myconfig->{dateformat} =~ /^dd/) {
309 ($dd, $mm, $yy) = split /\D/, $date;
312 $date = substr($date, 2);
313 ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
318 $yy = ($yy < 70) ? $yy + 2000 : $yy;
319 $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
321 if ($myconfig->{dateformat} =~ /^dd/) {
322 if (defined $longformat && $longformat == 0) {
324 $dd = "0$dd" if ($dd < 10);
325 $mm = "0$mm" if ($mm < 10);
326 $longdate = "$dd$spc$mm$spc$yy";
329 $longdate .= ($spc eq '.') ? ". " : " ";
330 $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
332 } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") {
334 # Use German syntax with the ISO date style "yyyy-mm-dd" because
335 # kivitendo is mainly used in Germany or German speaking countries.
336 if (defined $longformat && $longformat == 0) {
338 $dd = "0$dd" if ($dd < 10);
339 $mm = "0$mm" if ($mm < 10);
340 $longdate = "$yy-$mm-$dd";
343 $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
346 if (defined $longformat && $longformat == 0) {
348 $dd = "0$dd" if ($dd < 10);
349 $mm = "0$mm" if ($mm < 10);
350 $longdate = "$mm$spc$dd$spc$yy";
352 $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy";
356 $main::lxdebug->leave_sub();
362 $main::lxdebug->enter_sub(2);
364 my ($self, $myconfig, $date, $longformat) = @_;
365 my ($spc, $yy, $mm, $dd);
368 $main::lxdebug->leave_sub(2);
373 $spc = $myconfig->{dateformat};
375 $spc = substr($spc, 1, 1);
378 if ($myconfig->{dateformat} =~ /^yy/) {
379 ($yy, $mm, $dd) = split /\D/, $date;
380 } elsif ($myconfig->{dateformat} =~ /^mm/) {
381 ($mm, $dd, $yy) = split /\D/, $date;
382 } elsif ($myconfig->{dateformat} =~ /^dd/) {
383 ($dd, $mm, $yy) = split /\D/, $date;
386 $date = substr($date, 2);
387 ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
390 $_ ||= 0 for ($dd, $mm, $yy);
391 $_ *= 1 for ($dd, $mm, $yy);
392 $yy = ($yy < 70) ? $yy + 2000 : $yy;
393 $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
395 $main::lxdebug->leave_sub(2);
396 return ($yy, $mm, $dd);
399 sub parse_date_to_object {
400 my ($self, $string, %params) = @_;
402 return undef if !defined $string;
404 return DateTime->today_local if lc($string) eq 'today';
405 return DateTime->today_local->subtract(days => 1) if lc($string) eq 'yesterday';
407 $params{dateformat} ||= $::myconfig{dateformat} || 'yy-mm-dd';
408 $params{numberformat} ||= $::myconfig{numberformat} || '1,000.00';
409 my $num_separator = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
411 my ($date_str, $time_str) = split m{\s+}, $string, 2;
412 my ($yy, $mm, $dd) = $self->parse_date(\%params, $date_str);
414 my ($hour, $minute, $second) = split m/:/, ($time_str || '');
417 ($second, my $millisecond) = split quotemeta($num_separator), $second, 2;
418 $_ ||= 0 for ($hour, $minute, $millisecond);
420 $millisecond = substr $millisecond, 0, 3;
421 $millisecond .= '0' x (3 - length $millisecond);
423 return undef unless $yy && $mm && $dd;
424 return DateTime->new(year => $yy, month => $mm, day => $dd, hour => $hour * 1, minute => $minute * 1, second => $second * 1, nanosecond => $millisecond * 1000000);
427 sub format_date_object_to_time {
428 my ($self, $datetime, %params) = @_;
430 my $format = $::myconfig{timeformat} || 'hh:mm';
431 $format =~ s/hh/\%H/;
432 $format =~ s/mm/\%M/;
433 $format =~ s/ss/\%S/;
435 return $datetime->strftime($format);
438 sub format_date_object {
439 my ($self, $datetime, %params) = @_;
441 my $format = $params{dateformat} || $::myconfig{dateformat} || 'yyyy-mm-dd';
442 my $num_separator = ($params{numberformat} || $::myconfig{numberformat} || '1,000.00') =~ m{,\d+$} ? ',' : '.';
443 $format =~ s/yy(?:yy)?/\%Y/;
444 $format =~ s/mm/\%m/;
445 $format =~ s/dd/\%d/;
447 my $precision = $params{precision} || 'day';
448 $precision =~ s/s$//;
449 my %precision_spec_map = (
450 millisecond => '%H:%M:%S' . $num_separator . '%3N',
451 second => '%H:%M:%S',
456 $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
458 return $datetime->strftime($format);
462 $main::lxdebug->enter_sub(2);
464 my ($self, $myconfig, $date, $output_format, $longformat) = @_;
466 $main::lxdebug->leave_sub(2) and return "" unless ($date);
468 my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
470 $output_format =~ /(d+)/;
471 substr($output_format, $-[0], $+[0] - $-[0]) =
472 sprintf("%0" . (length($1)) . "d", $dd);
474 $output_format =~ /(m+)/;
475 substr($output_format, $-[0], $+[0] - $-[0]) =
476 sprintf("%0" . (length($1)) . "d", $mm);
478 $output_format =~ /y+/;
479 substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
481 $main::lxdebug->leave_sub(2);
483 return $output_format;
487 $main::lxdebug->enter_sub();
490 my $myconfig = shift;
494 my $yy_len = shift || 4;
496 ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
498 $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
500 $yy = $yy % 100 if 2 == $yy_len;
502 my $format = ref $myconfig eq '' ? "$myconfig" : $myconfig->{dateformat};
503 $format =~ s{ (d+) }{ sprintf("%0" . (length($1)) . "d", $dd) }gex;
504 $format =~ s{ (m+) }{ sprintf("%0" . (length($1)) . "d", $mm) }gex;
505 $format =~ s{ (y+) }{ sprintf("%0${yy_len}d", $yy) }gex;
507 $main::lxdebug->leave_sub();
512 sub quote_special_chars {
514 my $format = lc shift;
517 if ($self->{special_chars_map} && $self->{special_chars_map}->{$format} && $self->{special_chars_map}->{$format}->{order}) {
518 my $scmap = $self->{special_chars_map}->{$format};
520 map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
526 sub unquote_special_chars {
530 return $self->quote_special_chars("${format}-reverse", shift);
533 sub remap_special_chars {
535 my $src_format = shift;
536 my $dst_format = shift;
538 return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
544 return !!$self->{raw_io_active};
552 $self->{raw_io_active} = 1;
555 binmode $fh, ":utf8";
556 $self->{raw_io_active} = 0;
559 sub set_numberformat_wo_thousands_separator {
561 my $myconfig = shift || \%::myconfig;
563 $self->{saved_numberformat} = $myconfig->{numberformat};
564 $myconfig->{numberformat} =~ s/^1[,\.]/1/;
567 sub restore_numberformat {
569 my $myconfig = shift || \%::myconfig;
571 $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
574 sub get_local_time_zone {
576 $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
577 return $self->{local_time_zone};
581 my ($self, $items, %params) = @_;
584 $params{conjunction} ||= $::locale->text('and');
585 my $num = scalar @{ $items };
587 return 0 == $num ? ''
588 : 1 == $num ? $items->[0]
589 : join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
602 Locale - Functions for dealing with locale-dependent information
609 my $locale = Locale->new('de');
610 my $now = DateTime->now_local;
611 print "Current date and time: ", $::locale->format_date_object($now, precision => 'second'), "\n";
627 TODO: Describe findsub
631 TODO: Describe format_date
633 =item C<format_date_object $datetime, %params>
635 Formats the C<$datetime> object according to the user's locale setting.
637 The parameter C<precision> can control whether or not the time
638 component is formatted as well:
644 Only format the year, month and day. This is also the default.
648 Add the hour to the date.
652 Add hour:minute to the date.
656 Add hour:minute:second to the date.
658 =item * C<millisecond>
660 Add hour:minute:second.millisecond to the date. The decimal separator
661 is derived from the number format.
663 =item * C<numberformat>
665 The number format to use, e.g. C<1,000.00>. If unset the user's
666 current number format is used.
668 =item * C<dateformat>
670 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
675 =item C<get_local_time_zone>
677 TODO: Describe get_local_time_zone
679 =item C<lang_to_locale>
681 TODO: Describe lang_to_locale
689 TODO: Describe parse_date
691 =item C<parse_date_to_object $string, %params>
693 Parses a date and optional timestamp in C<$string> and returns an
694 instance of L<DateTime>. The date and number formats used are the ones
695 the user has currently selected. They can be overriden by passing them
696 in as parameters to this function, though.
698 The time stamps can have up to millisecond precision.
700 =item C<quote_special_chars>
702 TODO: Describe quote_special_chars
704 =item C<raw_io_active>
706 TODO: Describe raw_io_active
708 =item C<reformat_date>
710 TODO: Describe reformat_date
712 =item C<remap_special_chars>
714 TODO: Describe remap_special_chars
716 =item C<restore_numberformat>
718 TODO: Describe restore_numberformat
720 =item C<set_numberformat_wo_thousands_separator>
722 TODO: Describe set_numberformat_wo_thousands_separator
728 =item C<unquote_special_chars>
730 TODO: Describe unquote_special_chars
734 TODO: Describe with_raw_io
744 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>