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}
81 $self->{countrycode} = $country;
83 if ($country && -d "locale/$country") {
84 if (open my $in, "<", "locale/$country/all") {
91 if (-d "locale/$country/more") {
92 opendir my $dh, "locale/$country/more" or die "can't open locale/$country/more: $!";
93 my @files = sort grep -f "locale/$country/more/$_", readdir $dh;
96 for my $file (@files) {
97 if (open my $in, "<", "locale/$country/more/$file") {
102 $self->{texts}{$_} = $self->{more_texts}{$_} for keys %{ $self->{more_texts} };
108 binmode STDOUT, ":utf8";
109 binmode STDERR, ":utf8";
111 $self->{iconv} = SL::Iconv->new('UTF-8', 'UTF-8');
112 $self->{iconv_reverse} = SL::Iconv->new('UTF-8', 'UTF-8');
113 $self->{iconv_english} = SL::Iconv->new('ASCII', 'UTF-8');
114 $self->{iconv_iso8859} = SL::Iconv->new('ISO-8859-15', 'UTF-8');
115 $self->{iconv_to_iso8859} = SL::Iconv->new('UTF-8', 'ISO-8859-15');
116 $self->{iconv_utf8} = SL::Iconv->new('UTF-8', 'UTF-8');
118 $self->_read_special_chars_file($country);
120 push @{ $self->{LONG_MONTH} },
121 ("January", "February", "March", "April",
122 "May ", "June", "July", "August",
123 "September", "October", "November", "December");
124 push @{ $self->{SHORT_MONTH} },
125 (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
135 for (my $i = 0; $i < length $str; $i++) {
136 my $char = substr $str, $i, 1;
142 } elsif ($char eq 'r') {
145 } elsif ($char eq 's') {
148 } elsif ($char eq 'x') {
149 $new_str .= chr(hex(substr($str, $i + 1, 2)));
158 } elsif ($char eq '\\') {
169 sub _read_special_chars_file {
173 if (! -f "locale/$country/special_chars") {
174 $self->{special_chars_map} = {};
178 $self->{special_chars_map} = Inifile->new("locale/$country/special_chars", 'verbatim' => 1);
180 foreach my $format (keys %{ $self->{special_chars_map} }) {
181 next if (($format eq 'FILE') || ($format eq 'ORDER') || (ref $self->{special_chars_map}->{$format} ne 'HASH'));
183 if ($format ne lc $format) {
184 $self->{special_chars_map}->{lc $format} = $self->{special_chars_map}->{$format};
185 delete $self->{special_chars_map}->{$format};
186 $format = lc $format;
189 my $scmap = $self->{special_chars_map}->{$format};
190 my $order = $self->{iconv}->convert($scmap->{order});
191 delete $scmap->{order};
193 foreach my $key (keys %{ $scmap }) {
194 $scmap->{$key} = $self->_handle_markup($self->{iconv}->convert($scmap->{$key}));
196 my $new_key = $self->_handle_markup($self->{iconv}->convert($key));
198 if ($key ne $new_key) {
199 $scmap->{$new_key} = $scmap->{$key};
200 delete $scmap->{$key};
204 $self->{special_chars_map}->{"${format}-reverse"} = { reverse %{ $scmap } };
206 $scmap->{order} = [ map { $self->_handle_markup($_) } split m/\s+/, $order ];
207 $self->{special_chars_map}->{"${format}-reverse"}->{order} = [ grep { $_ } map { $scmap->{$_} } reverse @{ $scmap->{order} } ];
215 return $text->translated if (ref($text) || '') eq 'SL::Locale::String';
217 if ($self->{texts}->{$text}) {
218 $text = $self->{iconv}->convert($self->{texts}->{$text});
220 $text = $self->{iconv_english}->convert($text);
224 $text = Form->format_string($text, @_);
231 my ($self, $requested_lang) = @_;
233 my $requested_locale;
234 $requested_locale = 'de' if $requested_lang =~ m/^_(de|deu|ger)/i;
235 $requested_locale = 'en' if $requested_lang =~ m/^_(en|uk|us|gr)/i;
236 $requested_locale = 'fr' if $requested_lang =~ m/^_fr/i;
237 $requested_locale ||= 'de';
239 return $requested_locale;
243 $main::lxdebug->enter_sub();
245 my ($self, $text) = @_;
246 my $text_rev = lc $self->{iconv_reverse}->convert($text);
247 $text_rev =~ s/[\s\-]+/_/g;
249 if (!$self->{texts_reverse}) {
250 $self->{texts_reverse} = { };
251 while (my ($original, $translation) = each %{ $self->{texts} }) {
252 $original = lc $original;
253 $original =~ s/[^a-z0-9]/_/g;
254 $original =~ s/_+/_/g;
256 $translation = lc $translation;
257 $translation =~ s/[\s\-]+/_/g;
259 $self->{texts_reverse}->{$translation} ||= [ ];
260 push @{ $self->{texts_reverse}->{$translation} }, $original;
265 $sub_name = first { defined(&{ "::${_}" }) } @{ $self->{texts_reverse}->{$text_rev} } if $self->{texts_reverse}->{$text_rev};
266 $sub_name ||= $text_rev if ($text_rev =~ m/^[a-z][a-z0-9_]+$/) && defined &{ "::${text_rev}" };
268 $main::form->error("$text not defined in locale/$self->{countrycode}/all") if !$sub_name;
270 $main::lxdebug->leave_sub();
276 $main::lxdebug->enter_sub();
278 my ($self, $myconfig, $date, $longformat) = @_;
281 $main::lxdebug->leave_sub();
286 my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
288 my ($spc, $yy, $mm, $dd);
291 $spc = $myconfig->{dateformat};
293 $spc = substr($spc, 1, 1);
296 if ($myconfig->{dateformat} =~ /^yy/) {
297 ($yy, $mm, $dd) = split /\D/, $date;
299 if ($myconfig->{dateformat} =~ /^mm/) {
300 ($mm, $dd, $yy) = split /\D/, $date;
302 if ($myconfig->{dateformat} =~ /^dd/) {
303 ($dd, $mm, $yy) = split /\D/, $date;
306 $date = substr($date, 2);
307 ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
312 $yy = ($yy < 70) ? $yy + 2000 : $yy;
313 $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
315 if ($myconfig->{dateformat} =~ /^dd/) {
316 if (defined $longformat && $longformat == 0) {
318 $dd = "0$dd" if ($dd < 10);
319 $mm = "0$mm" if ($mm < 10);
320 $longdate = "$dd$spc$mm$spc$yy";
323 $longdate .= ($spc eq '.') ? ". " : " ";
324 $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
326 } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") {
328 # Use German syntax with the ISO date style "yyyy-mm-dd" because
329 # kivitendo is mainly used in Germany or German speaking countries.
330 if (defined $longformat && $longformat == 0) {
332 $dd = "0$dd" if ($dd < 10);
333 $mm = "0$mm" if ($mm < 10);
334 $longdate = "$yy-$mm-$dd";
337 $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
340 if (defined $longformat && $longformat == 0) {
342 $dd = "0$dd" if ($dd < 10);
343 $mm = "0$mm" if ($mm < 10);
344 $longdate = "$mm$spc$dd$spc$yy";
346 $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy";
350 $main::lxdebug->leave_sub();
356 $main::lxdebug->enter_sub(2);
358 my ($self, $myconfig, $date, $longformat) = @_;
359 my ($spc, $yy, $mm, $dd);
362 $main::lxdebug->leave_sub(2);
367 $spc = $myconfig->{dateformat};
369 $spc = substr($spc, 1, 1);
372 if ($myconfig->{dateformat} =~ /^yy/) {
373 ($yy, $mm, $dd) = split /\D/, $date;
374 } elsif ($myconfig->{dateformat} =~ /^mm/) {
375 ($mm, $dd, $yy) = split /\D/, $date;
376 } elsif ($myconfig->{dateformat} =~ /^dd/) {
377 ($dd, $mm, $yy) = split /\D/, $date;
380 $date = substr($date, 2);
381 ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
384 $_ ||= 0 for ($dd, $mm, $yy);
385 $_ *= 1 for ($dd, $mm, $yy);
386 $yy = ($yy < 70) ? $yy + 2000 : $yy;
387 $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
389 $main::lxdebug->leave_sub(2);
390 return ($yy, $mm, $dd);
393 sub parse_date_to_object {
394 my ($self, $string, %params) = @_;
396 return undef if !defined $string;
398 return DateTime->today_local if lc($string) eq 'today';
399 return DateTime->today_local->subtract(days => 1) if lc($string) eq 'yesterday';
401 $params{dateformat} ||= $::myconfig{dateformat} || 'yy-mm-dd';
402 $params{numberformat} ||= $::myconfig{numberformat} || '1,000.00';
403 my $num_separator = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
405 my ($date_str, $time_str) = split m{\s+}, $string, 2;
406 my ($yy, $mm, $dd) = $self->parse_date(\%params, $date_str);
408 my ($hour, $minute, $second) = split m/:/, ($time_str || '');
411 ($second, my $millisecond) = split quotemeta($num_separator), $second, 2;
412 $_ ||= 0 for ($hour, $minute, $millisecond);
414 $millisecond = substr $millisecond, 0, 3;
415 $millisecond .= '0' x (3 - length $millisecond);
417 return undef unless $yy && $mm && $dd;
418 return DateTime->new(year => $yy, month => $mm, day => $dd, hour => $hour * 1, minute => $minute * 1, second => $second * 1, nanosecond => $millisecond * 1000000);
421 sub format_date_object_to_time {
422 my ($self, $datetime, %params) = @_;
424 my $format = $::myconfig{timeformat} || 'hh:mm';
425 $format =~ s/hh/\%H/;
426 $format =~ s/mm/\%M/;
427 $format =~ s/ss/\%S/;
429 return $datetime->strftime($format);
432 sub format_date_object {
433 my ($self, $datetime, %params) = @_;
435 my $format = $params{dateformat} || $::myconfig{dateformat} || 'yyyy-mm-dd';
436 my $num_separator = ($params{numberformat} || $::myconfig{numberformat} || '1,000.00') =~ m{,\d+$} ? ',' : '.';
437 $format =~ s/yy(?:yy)?/\%Y/;
438 $format =~ s/mm/\%m/;
439 $format =~ s/dd/\%d/;
441 my $precision = $params{precision} || 'day';
442 $precision =~ s/s$//;
443 my %precision_spec_map = (
444 millisecond => '%H:%M:%S' . $num_separator . '%3N',
445 second => '%H:%M:%S',
450 $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
452 return $datetime->strftime($format);
456 $main::lxdebug->enter_sub(2);
458 my ($self, $myconfig, $date, $output_format, $longformat) = @_;
460 $main::lxdebug->leave_sub(2) and return "" unless ($date);
462 my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
464 $output_format =~ /(d+)/;
465 substr($output_format, $-[0], $+[0] - $-[0]) =
466 sprintf("%0" . (length($1)) . "d", $dd);
468 $output_format =~ /(m+)/;
469 substr($output_format, $-[0], $+[0] - $-[0]) =
470 sprintf("%0" . (length($1)) . "d", $mm);
472 $output_format =~ /y+/;
473 substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
475 $main::lxdebug->leave_sub(2);
477 return $output_format;
481 $main::lxdebug->enter_sub();
484 my $myconfig = shift;
488 my $yy_len = shift || 4;
490 ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
492 $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
494 $yy = $yy % 100 if 2 == $yy_len;
496 my $format = ref $myconfig eq '' ? "$myconfig" : $myconfig->{dateformat};
497 $format =~ s{ (d+) }{ sprintf("%0" . (length($1)) . "d", $dd) }gex;
498 $format =~ s{ (m+) }{ sprintf("%0" . (length($1)) . "d", $mm) }gex;
499 $format =~ s{ (y+) }{ sprintf("%0${yy_len}d", $yy) }gex;
501 $main::lxdebug->leave_sub();
506 sub quote_special_chars {
508 my $format = lc shift;
511 if ($self->{special_chars_map} && $self->{special_chars_map}->{$format} && $self->{special_chars_map}->{$format}->{order}) {
512 my $scmap = $self->{special_chars_map}->{$format};
514 map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
520 sub unquote_special_chars {
524 return $self->quote_special_chars("${format}-reverse", shift);
527 sub remap_special_chars {
529 my $src_format = shift;
530 my $dst_format = shift;
532 return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
538 return !!$self->{raw_io_active};
546 $self->{raw_io_active} = 1;
549 binmode $fh, ":utf8";
550 $self->{raw_io_active} = 0;
553 sub set_numberformat_wo_thousands_separator {
555 my $myconfig = shift || \%::myconfig;
557 $self->{saved_numberformat} = $myconfig->{numberformat};
558 $myconfig->{numberformat} =~ s/^1[,\.]/1/;
561 sub restore_numberformat {
563 my $myconfig = shift || \%::myconfig;
565 $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
568 sub get_local_time_zone {
570 $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
571 return $self->{local_time_zone};
575 my ($self, $items, %params) = @_;
578 $params{conjunction} ||= $::locale->text('and');
579 my $num = scalar @{ $items };
581 return 0 == $num ? ''
582 : 1 == $num ? $items->[0]
583 : join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
596 Locale - Functions for dealing with locale-dependent information
603 my $locale = Locale->new('de');
604 my $now = DateTime->now_local;
605 print "Current date and time: ", $::locale->format_date_object($now, precision => 'second'), "\n";
621 TODO: Describe findsub
625 TODO: Describe format_date
627 =item C<format_date_object $datetime, %params>
629 Formats the C<$datetime> object according to the user's locale setting.
631 The parameter C<precision> can control whether or not the time
632 component is formatted as well:
638 Only format the year, month and day. This is also the default.
642 Add the hour to the date.
646 Add hour:minute to the date.
650 Add hour:minute:second to the date.
652 =item * C<millisecond>
654 Add hour:minute:second.millisecond to the date. The decimal separator
655 is derived from the number format.
657 =item * C<numberformat>
659 The number format to use, e.g. C<1,000.00>. If unset the user's
660 current number format is used.
662 =item * C<dateformat>
664 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
669 =item C<get_local_time_zone>
671 TODO: Describe get_local_time_zone
673 =item C<lang_to_locale>
675 TODO: Describe lang_to_locale
683 TODO: Describe parse_date
685 =item C<parse_date_to_object $string, %params>
687 Parses a date and optional timestamp in C<$string> and returns an
688 instance of L<DateTime>. The date and number formats used are the ones
689 the user has currently selected. They can be overriden by passing them
690 in as parameters to this function, though.
692 The time stamps can have up to millisecond precision.
694 =item C<quote_special_chars>
696 TODO: Describe quote_special_chars
698 =item C<raw_io_active>
700 TODO: Describe raw_io_active
702 =item C<reformat_date>
704 TODO: Describe reformat_date
706 =item C<remap_special_chars>
708 TODO: Describe remap_special_chars
710 =item C<restore_numberformat>
712 TODO: Describe restore_numberformat
714 =item C<set_numberformat_wo_thousands_separator>
716 TODO: Describe set_numberformat_wo_thousands_separator
722 =item C<unquote_special_chars>
724 TODO: Describe unquote_special_chars
728 TODO: Describe with_raw_io
738 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>