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., 675 Mass Ave, Cambridge, MA 02139, USA.
31 #======================================================================
33 # Translations and number/date formatting
35 #======================================================================
41 use List::Util qw(first);
42 use List::MoreUtils qw(any);
52 my %locales_by_language;
55 $main::lxdebug->enter_sub();
57 my ($type, $language) = @_;
59 $language ||= $::lx_office_conf{system}->{language};
63 if (!$locales_by_language{$language}) {
67 $self->_init($language);
69 $locales_by_language{$language} = $self;
72 $main::lxdebug->leave_sub();
74 return $locales_by_language{$language}
81 $self->{countrycode} = $language;
83 if ($language && -d "locale/$language") {
85 if (open(IN, "<", "locale/$language/all")) {
86 my $code = join("", <IN>);
91 if (-d "locale/$language/more") {
92 opendir my $dh, "locale/$language/more" or die "can't open locale/$language/more: $!";
93 my @files = sort grep -f "locale/$language/more/$_", readdir $dh;
96 for my $file (@files) {
97 if (open my $in, "<", "locale/$language/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($language);
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 {
171 my $language = shift;
173 if (! -f "locale/$language/special_chars") {
174 $self->{special_chars_map} = {};
178 $self->{special_chars_map} = Inifile->new("locale/$language/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 $params{dateformat} ||= $::myconfig{dateformat} || 'yy-mm-dd';
399 $params{numberformat} ||= $::myconfig{numberformat} || '1,000.00';
400 my $num_separator = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
402 my ($date_str, $time_str) = split m{\s+}, $string, 2;
403 my ($yy, $mm, $dd) = $self->parse_date(\%params, $date_str);
405 my ($hour, $minute, $second) = split m/:/, ($time_str || '');
408 ($second, my $millisecond) = split quotemeta($num_separator), $second, 2;
409 $_ ||= 0 for ($hour, $minute, $millisecond);
411 $millisecond = substr $millisecond, 0, 3;
412 $millisecond .= '0' x (3 - length $millisecond);
414 return undef unless $yy && $mm && $dd;
415 return DateTime->new(year => $yy, month => $mm, day => $dd, hour => $hour * 1, minute => $minute * 1, second => $second * 1, nanosecond => $millisecond * 1000000);
418 sub format_date_object_to_time {
419 my ($self, $datetime, %params) = @_;
421 my $format = $::myconfig{timeformat} || 'hh:mm';
422 $format =~ s/hh/\%H/;
423 $format =~ s/mm/\%M/;
424 $format =~ s/ss/\%S/;
426 return $datetime->strftime($format);
429 sub format_date_object {
430 my ($self, $datetime, %params) = @_;
432 my $format = $params{dateformat} || $::myconfig{dateformat} || 'yyyy-mm-dd';
433 my $num_separator = ($params{numberformat} || $::myconfig{numberformat} || '1,000.00') =~ m{,\d+$} ? ',' : '.';
434 $format =~ s/yy(?:yy)?/\%Y/;
435 $format =~ s/mm/\%m/;
436 $format =~ s/dd/\%d/;
438 my $precision = $params{precision} || 'day';
439 $precision =~ s/s$//;
440 my %precision_spec_map = (
441 millisecond => '%H:%M:%S' . $num_separator . '%3N',
442 second => '%H:%M:%S',
447 $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
449 return $datetime->strftime($format);
453 $main::lxdebug->enter_sub(2);
455 my ($self, $myconfig, $date, $output_format, $longformat) = @_;
457 $main::lxdebug->leave_sub(2) and return "" unless ($date);
459 my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
461 $output_format =~ /(d+)/;
462 substr($output_format, $-[0], $+[0] - $-[0]) =
463 sprintf("%0" . (length($1)) . "d", $dd);
465 $output_format =~ /(m+)/;
466 substr($output_format, $-[0], $+[0] - $-[0]) =
467 sprintf("%0" . (length($1)) . "d", $mm);
469 $output_format =~ /y+/;
470 substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
472 $main::lxdebug->leave_sub(2);
474 return $output_format;
478 $main::lxdebug->enter_sub();
481 my $myconfig = shift;
485 my $yy_len = shift || 4;
487 ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
489 $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
491 $yy = $yy % 100 if 2 == $yy_len;
493 my $format = ref $myconfig eq '' ? "$myconfig" : $myconfig->{dateformat};
494 $format =~ s{ (d+) }{ sprintf("%0" . (length($1)) . "d", $dd) }gex;
495 $format =~ s{ (m+) }{ sprintf("%0" . (length($1)) . "d", $mm) }gex;
496 $format =~ s{ (y+) }{ sprintf("%0${yy_len}d", $yy) }gex;
498 $main::lxdebug->leave_sub();
503 sub quote_special_chars {
505 my $format = lc shift;
508 if ($self->{special_chars_map} && $self->{special_chars_map}->{$format} && $self->{special_chars_map}->{$format}->{order}) {
509 my $scmap = $self->{special_chars_map}->{$format};
511 map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
517 sub unquote_special_chars {
521 return $self->quote_special_chars("${format}-reverse", shift);
524 sub remap_special_chars {
526 my $src_format = shift;
527 my $dst_format = shift;
529 return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
535 return !!$self->{raw_io_active};
543 $self->{raw_io_active} = 1;
546 binmode $fh, ":utf8";
547 $self->{raw_io_active} = 0;
550 sub set_numberformat_wo_thousands_separator {
552 my $myconfig = shift || \%::myconfig;
554 $self->{saved_numberformat} = $myconfig->{numberformat};
555 $myconfig->{numberformat} =~ s/^1[,\.]/1/;
558 sub restore_numberformat {
560 my $myconfig = shift || \%::myconfig;
562 $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
565 sub get_local_time_zone {
567 $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
568 return $self->{local_time_zone};
572 my ($self, $items, %params) = @_;
575 $params{conjunction} ||= $::locale->text('and');
576 my $num = scalar @{ $items };
578 return 0 == $num ? ''
579 : 1 == $num ? $items->[0]
580 : join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
593 Locale - Functions for dealing with locale-dependent information
600 my $locale = Locale->new('de');
601 my $now = DateTime->now_local;
602 print "Current date and time: ", $::locale->format_date_object($now, precision => 'second'), "\n";
618 TODO: Describe findsub
622 TODO: Describe format_date
624 =item C<format_date_object $datetime, %params>
626 Formats the C<$datetime> object accoring to the user's locale setting.
628 The parameter C<precision> can control whether or not the time
629 component is formatted as well:
635 Only format the year, month and day. This is also the default.
639 Add the hour to the date.
643 Add hour:minute to the date.
647 Add hour:minute:second to the date.
649 =item * C<millisecond>
651 Add hour:minute:second.millisecond to the date. The decimal separator
652 is derived from the number format.
654 =item * C<numberformat>
656 The number format to use, e.g. C<1,000.00>. If unset the user's
657 current number format is used.
659 =item * C<dateformat>
661 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
666 =item C<get_local_time_zone>
668 TODO: Describe get_local_time_zone
670 =item C<lang_to_locale>
672 TODO: Describe lang_to_locale
680 TODO: Describe parse_date
682 =item C<parse_date_to_object $string, %params>
684 Parses a date and optional timestamp in C<$string> and returns an
685 instance of L<DateTime>. The date and number formats used are the ones
686 the user has currently selected. They can be overriden by passing them
687 in as parameters to this function, though.
689 The time stamps can have up to millisecond precision.
691 =item C<quote_special_chars>
693 TODO: Describe quote_special_chars
695 =item C<raw_io_active>
697 TODO: Describe raw_io_active
699 =item C<reformat_date>
701 TODO: Describe reformat_date
703 =item C<remap_special_chars>
705 TODO: Describe remap_special_chars
707 =item C<restore_numberformat>
709 TODO: Describe restore_numberformat
711 =item C<set_numberformat_wo_thousands_separator>
713 TODO: Describe set_numberformat_wo_thousands_separator
719 =item C<unquote_special_chars>
721 TODO: Describe unquote_special_chars
725 TODO: Describe with_raw_io
735 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>