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);
51 my %locales_by_country;
54 $main::lxdebug->enter_sub();
56 my ($type, $country) = @_;
58 $country ||= $::lx_office_conf{system}->{language};
62 if (!$locales_by_country{$country}) {
66 $self->_init($country);
68 $locales_by_country{$country} = $self;
71 $main::lxdebug->leave_sub();
73 return $locales_by_country{$country}
80 $self->{countrycode} = $country;
82 if ($country && -d "locale/$country") {
83 if (open my $in, "<", "locale/$country/all") {
90 if (-d "locale/$country/more") {
91 opendir my $dh, "locale/$country/more" or die "can't open locale/$country/more: $!";
92 my @files = sort grep -f "locale/$country/more/$_", readdir $dh;
95 for my $file (@files) {
96 if (open my $in, "<", "locale/$country/more/$file") {
101 $self->{texts}{$_} = $self->{more_texts}{$_} for keys %{ $self->{more_texts} };
107 binmode STDOUT, ":utf8";
108 binmode STDERR, ":utf8";
110 $self->{iconv} = SL::Iconv->new('UTF-8', 'UTF-8');
111 $self->{iconv_reverse} = SL::Iconv->new('UTF-8', 'UTF-8');
112 $self->{iconv_english} = SL::Iconv->new('ASCII', 'UTF-8');
113 $self->{iconv_iso8859} = SL::Iconv->new('ISO-8859-15', 'UTF-8');
114 $self->{iconv_to_iso8859} = SL::Iconv->new('UTF-8', 'ISO-8859-15');
115 $self->{iconv_utf8} = SL::Iconv->new('UTF-8', 'UTF-8');
117 $self->_read_special_chars_file($country);
119 push @{ $self->{LONG_MONTH} },
120 ("January", "February", "March", "April",
121 "May ", "June", "July", "August",
122 "September", "October", "November", "December");
123 push @{ $self->{SHORT_MONTH} },
124 (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
134 for (my $i = 0; $i < length $str; $i++) {
135 my $char = substr $str, $i, 1;
141 } elsif ($char eq 'r') {
144 } elsif ($char eq 's') {
147 } elsif ($char eq 'x') {
148 $new_str .= chr(hex(substr($str, $i + 1, 2)));
157 } elsif ($char eq '\\') {
168 sub _read_special_chars_file {
172 if (! -f "locale/$country/special_chars") {
173 $self->{special_chars_map} = {};
177 $self->{special_chars_map} = Inifile->new("locale/$country/special_chars", 'verbatim' => 1);
179 foreach my $format (keys %{ $self->{special_chars_map} }) {
180 next if (($format eq 'FILE') || ($format eq 'ORDER') || (ref $self->{special_chars_map}->{$format} ne 'HASH'));
182 if ($format ne lc $format) {
183 $self->{special_chars_map}->{lc $format} = $self->{special_chars_map}->{$format};
184 delete $self->{special_chars_map}->{$format};
185 $format = lc $format;
188 my $scmap = $self->{special_chars_map}->{$format};
189 my $order = $self->{iconv}->convert($scmap->{order});
190 delete $scmap->{order};
192 foreach my $key (keys %{ $scmap }) {
193 $scmap->{$key} = $self->_handle_markup($self->{iconv}->convert($scmap->{$key}));
195 my $new_key = $self->_handle_markup($self->{iconv}->convert($key));
197 if ($key ne $new_key) {
198 $scmap->{$new_key} = $scmap->{$key};
199 delete $scmap->{$key};
203 $self->{special_chars_map}->{"${format}-reverse"} = { reverse %{ $scmap } };
205 $scmap->{order} = [ map { $self->_handle_markup($_) } split m/\s+/, $order ];
206 $self->{special_chars_map}->{"${format}-reverse"}->{order} = [ grep { $_ } map { $scmap->{$_} } reverse @{ $scmap->{order} } ];
214 return $text->translated if (ref($text) || '') eq 'SL::Locale::String';
216 if ($self->{texts}->{$text}) {
217 $text = $self->{iconv}->convert($self->{texts}->{$text});
219 $text = $self->{iconv_english}->convert($text);
223 $text = Form->format_string($text, @_);
230 my ($self, $requested_lang) = @_;
232 my $requested_locale;
233 $requested_locale = 'de' if $requested_lang =~ m/^_(de|deu|ger)/i;
234 $requested_locale = 'en' if $requested_lang =~ m/^_(en|uk|us|gr)/i;
235 $requested_locale = 'fr' if $requested_lang =~ m/^_fr/i;
236 $requested_locale ||= 'de';
238 return $requested_locale;
242 $main::lxdebug->enter_sub();
244 my ($self, $text) = @_;
245 my $text_rev = lc $self->{iconv_reverse}->convert($text);
246 $text_rev =~ s/[\s\-]+/_/g;
248 if (!$self->{texts_reverse}) {
249 $self->{texts_reverse} = { };
250 while (my ($original, $translation) = each %{ $self->{texts} }) {
251 $original = lc $original;
252 $original =~ s/[^a-z0-9]/_/g;
253 $original =~ s/_+/_/g;
255 $translation = lc $translation;
256 $translation =~ s/[\s\-]+/_/g;
258 $self->{texts_reverse}->{$translation} ||= [ ];
259 push @{ $self->{texts_reverse}->{$translation} }, $original;
264 $sub_name = first { defined(&{ "::${_}" }) } @{ $self->{texts_reverse}->{$text_rev} } if $self->{texts_reverse}->{$text_rev};
265 $sub_name ||= $text_rev if ($text_rev =~ m/^[a-z][a-z0-9_]+$/) && defined &{ "::${text_rev}" };
267 $main::form->error("$text not defined in locale/$self->{countrycode}/all") if !$sub_name;
269 $main::lxdebug->leave_sub();
275 $main::lxdebug->enter_sub();
277 my ($self, $myconfig, $date, $longformat) = @_;
280 $main::lxdebug->leave_sub();
285 my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
287 my ($spc, $yy, $mm, $dd);
290 $spc = $myconfig->{dateformat};
292 $spc = substr($spc, 1, 1);
295 if ($myconfig->{dateformat} =~ /^yy/) {
296 ($yy, $mm, $dd) = split /\D/, $date;
298 if ($myconfig->{dateformat} =~ /^mm/) {
299 ($mm, $dd, $yy) = split /\D/, $date;
301 if ($myconfig->{dateformat} =~ /^dd/) {
302 ($dd, $mm, $yy) = split /\D/, $date;
305 $date = substr($date, 2);
306 ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
311 $yy = ($yy < 70) ? $yy + 2000 : $yy;
312 $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
314 if ($myconfig->{dateformat} =~ /^dd/) {
315 if (defined $longformat && $longformat == 0) {
317 $dd = "0$dd" if ($dd < 10);
318 $mm = "0$mm" if ($mm < 10);
319 $longdate = "$dd$spc$mm$spc$yy";
322 $longdate .= ($spc eq '.') ? ". " : " ";
323 $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
325 } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") {
327 # Use German syntax with the ISO date style "yyyy-mm-dd" because
328 # kivitendo is mainly used in Germany or German speaking countries.
329 if (defined $longformat && $longformat == 0) {
331 $dd = "0$dd" if ($dd < 10);
332 $mm = "0$mm" if ($mm < 10);
333 $longdate = "$yy-$mm-$dd";
336 $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
339 if (defined $longformat && $longformat == 0) {
341 $dd = "0$dd" if ($dd < 10);
342 $mm = "0$mm" if ($mm < 10);
343 $longdate = "$mm$spc$dd$spc$yy";
345 $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy";
349 $main::lxdebug->leave_sub();
355 $main::lxdebug->enter_sub(2);
357 my ($self, $myconfig, $date, $longformat) = @_;
358 my ($spc, $yy, $mm, $dd);
361 $main::lxdebug->leave_sub(2);
366 $spc = $myconfig->{dateformat};
368 $spc = substr($spc, 1, 1);
371 if ($myconfig->{dateformat} =~ /^yy/) {
372 ($yy, $mm, $dd) = split /\D/, $date;
373 } elsif ($myconfig->{dateformat} =~ /^mm/) {
374 ($mm, $dd, $yy) = split /\D/, $date;
375 } elsif ($myconfig->{dateformat} =~ /^dd/) {
376 ($dd, $mm, $yy) = split /\D/, $date;
379 $date = substr($date, 2);
380 ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
383 $_ ||= 0 for ($dd, $mm, $yy);
384 $_ *= 1 for ($dd, $mm, $yy);
385 $yy = ($yy < 70) ? $yy + 2000 : $yy;
386 $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
388 $main::lxdebug->leave_sub(2);
389 return ($yy, $mm, $dd);
392 sub parse_date_to_object {
393 my ($self, $string, %params) = @_;
395 return undef if !defined $string;
397 return DateTime->today_local if lc($string) eq 'today';
398 return DateTime->today_local->subtract(days => 1) if lc($string) eq 'yesterday';
400 $params{dateformat} ||= $::myconfig{dateformat} || 'yy-mm-dd';
401 $params{numberformat} ||= $::myconfig{numberformat} || '1,000.00';
402 my $num_separator = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
404 my ($date_str, $time_str) = split m{\s+}, $string, 2;
405 my ($yy, $mm, $dd) = $self->parse_date(\%params, $date_str);
407 my ($hour, $minute, $second) = split m/:/, ($time_str || '');
410 ($second, my $millisecond) = split quotemeta($num_separator), $second, 2;
411 $_ ||= 0 for ($hour, $minute, $millisecond);
413 $millisecond = substr $millisecond, 0, 3;
414 $millisecond .= '0' x (3 - length $millisecond);
416 return undef unless $yy && $mm && $dd;
417 return DateTime->new(year => $yy, month => $mm, day => $dd, hour => $hour * 1, minute => $minute * 1, second => $second * 1, nanosecond => $millisecond * 1000000);
420 sub format_date_object_to_time {
421 my ($self, $datetime, %params) = @_;
423 my $format = $::myconfig{timeformat} || 'hh:mm';
424 $format =~ s/hh/\%H/;
425 $format =~ s/mm/\%M/;
426 $format =~ s/ss/\%S/;
428 return $datetime->strftime($format);
431 sub format_date_object {
432 my ($self, $datetime, %params) = @_;
434 my $format = $params{dateformat} || $::myconfig{dateformat} || 'yyyy-mm-dd';
435 my $num_separator = ($params{numberformat} || $::myconfig{numberformat} || '1,000.00') =~ m{,\d+$} ? ',' : '.';
436 $format =~ s/yy(?:yy)?/\%Y/;
437 $format =~ s/mm/\%m/;
438 $format =~ s/dd/\%d/;
440 my $precision = $params{precision} || 'day';
441 $precision =~ s/s$//;
442 my %precision_spec_map = (
443 millisecond => '%H:%M:%S' . $num_separator . '%3N',
444 second => '%H:%M:%S',
449 $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
451 return $datetime->strftime($format);
455 $main::lxdebug->enter_sub(2);
457 my ($self, $myconfig, $date, $output_format, $longformat) = @_;
459 $main::lxdebug->leave_sub(2) and return "" unless ($date);
461 my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
463 $output_format =~ /(d+)/;
464 substr($output_format, $-[0], $+[0] - $-[0]) =
465 sprintf("%0" . (length($1)) . "d", $dd);
467 $output_format =~ /(m+)/;
468 substr($output_format, $-[0], $+[0] - $-[0]) =
469 sprintf("%0" . (length($1)) . "d", $mm);
471 $output_format =~ /y+/;
472 substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
474 $main::lxdebug->leave_sub(2);
476 return $output_format;
480 $main::lxdebug->enter_sub();
483 my $myconfig = shift;
487 my $yy_len = shift || 4;
489 ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
491 $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
493 $yy = $yy % 100 if 2 == $yy_len;
495 my $format = ref $myconfig eq '' ? "$myconfig" : $myconfig->{dateformat};
496 $format =~ s{ (d+) }{ sprintf("%0" . (length($1)) . "d", $dd) }gex;
497 $format =~ s{ (m+) }{ sprintf("%0" . (length($1)) . "d", $mm) }gex;
498 $format =~ s{ (y+) }{ sprintf("%0${yy_len}d", $yy) }gex;
500 $main::lxdebug->leave_sub();
505 sub quote_special_chars {
507 my $format = lc shift;
510 if ($self->{special_chars_map} && $self->{special_chars_map}->{$format} && $self->{special_chars_map}->{$format}->{order}) {
511 my $scmap = $self->{special_chars_map}->{$format};
513 map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
519 sub unquote_special_chars {
523 return $self->quote_special_chars("${format}-reverse", shift);
526 sub remap_special_chars {
528 my $src_format = shift;
529 my $dst_format = shift;
531 return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
537 return !!$self->{raw_io_active};
545 $self->{raw_io_active} = 1;
548 binmode $fh, ":utf8";
549 $self->{raw_io_active} = 0;
552 sub set_numberformat_wo_thousands_separator {
554 my $myconfig = shift || \%::myconfig;
556 $self->{saved_numberformat} = $myconfig->{numberformat};
557 $myconfig->{numberformat} =~ s/^1[,\.]/1/;
560 sub restore_numberformat {
562 my $myconfig = shift || \%::myconfig;
564 $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
567 sub get_local_time_zone {
569 $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
570 return $self->{local_time_zone};
574 my ($self, $items, %params) = @_;
577 $params{conjunction} ||= $::locale->text('and');
578 my $num = scalar @{ $items };
580 return 0 == $num ? ''
581 : 1 == $num ? $items->[0]
582 : join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
595 Locale - Functions for dealing with locale-dependent information
602 my $locale = Locale->new('de');
603 my $now = DateTime->now_local;
604 print "Current date and time: ", $::locale->format_date_object($now, precision => 'second'), "\n";
620 TODO: Describe findsub
624 TODO: Describe format_date
626 =item C<format_date_object $datetime, %params>
628 Formats the C<$datetime> object accoring to the user's locale setting.
630 The parameter C<precision> can control whether or not the time
631 component is formatted as well:
637 Only format the year, month and day. This is also the default.
641 Add the hour to the date.
645 Add hour:minute to the date.
649 Add hour:minute:second to the date.
651 =item * C<millisecond>
653 Add hour:minute:second.millisecond to the date. The decimal separator
654 is derived from the number format.
656 =item * C<numberformat>
658 The number format to use, e.g. C<1,000.00>. If unset the user's
659 current number format is used.
661 =item * C<dateformat>
663 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
668 =item C<get_local_time_zone>
670 TODO: Describe get_local_time_zone
672 =item C<lang_to_locale>
674 TODO: Describe lang_to_locale
682 TODO: Describe parse_date
684 =item C<parse_date_to_object $string, %params>
686 Parses a date and optional timestamp in C<$string> and returns an
687 instance of L<DateTime>. The date and number formats used are the ones
688 the user has currently selected. They can be overriden by passing them
689 in as parameters to this function, though.
691 The time stamps can have up to millisecond precision.
693 =item C<quote_special_chars>
695 TODO: Describe quote_special_chars
697 =item C<raw_io_active>
699 TODO: Describe raw_io_active
701 =item C<reformat_date>
703 TODO: Describe reformat_date
705 =item C<remap_special_chars>
707 TODO: Describe remap_special_chars
709 =item C<restore_numberformat>
711 TODO: Describe restore_numberformat
713 =item C<set_numberformat_wo_thousands_separator>
715 TODO: Describe set_numberformat_wo_thousands_separator
721 =item C<unquote_special_chars>
723 TODO: Describe unquote_special_chars
727 TODO: Describe with_raw_io
737 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>