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") {
84 if (open(IN, "<", "locale/$country/all")) {
85 my $code = join("", <IN>);
91 binmode STDOUT, ":utf8";
92 binmode STDERR, ":utf8";
94 $self->{iconv} = SL::Iconv->new('UTF-8', 'UTF-8');
95 $self->{iconv_reverse} = SL::Iconv->new('UTF-8', 'UTF-8');
96 $self->{iconv_english} = SL::Iconv->new('ASCII', 'UTF-8');
97 $self->{iconv_iso8859} = SL::Iconv->new('ISO-8859-15', 'UTF-8');
98 $self->{iconv_to_iso8859} = SL::Iconv->new('UTF-8', 'ISO-8859-15');
99 $self->{iconv_utf8} = SL::Iconv->new('UTF-8', 'UTF-8');
101 $self->_read_special_chars_file($country);
103 push @{ $self->{LONG_MONTH} },
104 ("January", "February", "March", "April",
105 "May ", "June", "July", "August",
106 "September", "October", "November", "December");
107 push @{ $self->{SHORT_MONTH} },
108 (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
118 for (my $i = 0; $i < length $str; $i++) {
119 my $char = substr $str, $i, 1;
125 } elsif ($char eq 'r') {
128 } elsif ($char eq 's') {
131 } elsif ($char eq 'x') {
132 $new_str .= chr(hex(substr($str, $i + 1, 2)));
141 } elsif ($char eq '\\') {
152 sub _read_special_chars_file {
156 if (! -f "locale/$country/special_chars") {
157 $self->{special_chars_map} = {};
161 $self->{special_chars_map} = Inifile->new("locale/$country/special_chars", 'verbatim' => 1);
163 foreach my $format (keys %{ $self->{special_chars_map} }) {
164 next if (($format eq 'FILE') || ($format eq 'ORDER') || (ref $self->{special_chars_map}->{$format} ne 'HASH'));
166 if ($format ne lc $format) {
167 $self->{special_chars_map}->{lc $format} = $self->{special_chars_map}->{$format};
168 delete $self->{special_chars_map}->{$format};
169 $format = lc $format;
172 my $scmap = $self->{special_chars_map}->{$format};
173 my $order = $self->{iconv}->convert($scmap->{order});
174 delete $scmap->{order};
176 foreach my $key (keys %{ $scmap }) {
177 $scmap->{$key} = $self->_handle_markup($self->{iconv}->convert($scmap->{$key}));
179 my $new_key = $self->_handle_markup($self->{iconv}->convert($key));
181 if ($key ne $new_key) {
182 $scmap->{$new_key} = $scmap->{$key};
183 delete $scmap->{$key};
187 $self->{special_chars_map}->{"${format}-reverse"} = { reverse %{ $scmap } };
189 $scmap->{order} = [ map { $self->_handle_markup($_) } split m/\s+/, $order ];
190 $self->{special_chars_map}->{"${format}-reverse"}->{order} = [ grep { $_ } map { $scmap->{$_} } reverse @{ $scmap->{order} } ];
198 return $text->translated if (ref($text) || '') eq 'SL::Locale::String';
200 if ($self->{texts}->{$text}) {
201 $text = $self->{iconv}->convert($self->{texts}->{$text});
203 $text = $self->{iconv_english}->convert($text);
207 $text = Form->format_string($text, @_);
214 my ($self, $requested_lang) = @_;
216 my $requested_locale;
217 $requested_locale = 'de' if $requested_lang =~ m/^_(de|deu|ger)/i;
218 $requested_locale = 'en' if $requested_lang =~ m/^_(en|uk|us|gr)/i;
219 $requested_locale = 'fr' if $requested_lang =~ m/^_fr/i;
220 $requested_locale ||= 'de';
222 return $requested_locale;
226 $main::lxdebug->enter_sub();
228 my ($self, $text) = @_;
229 my $text_rev = lc $self->{iconv_reverse}->convert($text);
230 $text_rev =~ s/[\s\-]+/_/g;
232 if (!$self->{texts_reverse}) {
233 $self->{texts_reverse} = { };
234 while (my ($original, $translation) = each %{ $self->{texts} }) {
235 $original = lc $original;
236 $original =~ s/[^a-z0-9]/_/g;
237 $original =~ s/_+/_/g;
239 $translation = lc $translation;
240 $translation =~ s/[\s\-]+/_/g;
242 $self->{texts_reverse}->{$translation} ||= [ ];
243 push @{ $self->{texts_reverse}->{$translation} }, $original;
248 $sub_name = first { defined(&{ "::${_}" }) } @{ $self->{texts_reverse}->{$text_rev} } if $self->{texts_reverse}->{$text_rev};
249 $sub_name ||= $text_rev if ($text_rev =~ m/^[a-z][a-z0-9_]+$/) && defined &{ "::${text_rev}" };
251 $main::form->error("$text not defined in locale/$self->{countrycode}/all") if !$sub_name;
253 $main::lxdebug->leave_sub();
259 $main::lxdebug->enter_sub();
261 my ($self, $myconfig, $date, $longformat) = @_;
264 $main::lxdebug->leave_sub();
269 my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
271 my ($spc, $yy, $mm, $dd);
274 $spc = $myconfig->{dateformat};
276 $spc = substr($spc, 1, 1);
279 if ($myconfig->{dateformat} =~ /^yy/) {
280 ($yy, $mm, $dd) = split /\D/, $date;
282 if ($myconfig->{dateformat} =~ /^mm/) {
283 ($mm, $dd, $yy) = split /\D/, $date;
285 if ($myconfig->{dateformat} =~ /^dd/) {
286 ($dd, $mm, $yy) = split /\D/, $date;
289 $date = substr($date, 2);
290 ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
295 $yy = ($yy < 70) ? $yy + 2000 : $yy;
296 $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
298 if ($myconfig->{dateformat} =~ /^dd/) {
299 if (defined $longformat && $longformat == 0) {
301 $dd = "0$dd" if ($dd < 10);
302 $mm = "0$mm" if ($mm < 10);
303 $longdate = "$dd$spc$mm$spc$yy";
306 $longdate .= ($spc eq '.') ? ". " : " ";
307 $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
309 } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") {
311 # Use German syntax with the ISO date style "yyyy-mm-dd" because
312 # kivitendo is mainly used in Germany or German speaking countries.
313 if (defined $longformat && $longformat == 0) {
315 $dd = "0$dd" if ($dd < 10);
316 $mm = "0$mm" if ($mm < 10);
317 $longdate = "$yy-$mm-$dd";
320 $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
323 if (defined $longformat && $longformat == 0) {
325 $dd = "0$dd" if ($dd < 10);
326 $mm = "0$mm" if ($mm < 10);
327 $longdate = "$mm$spc$dd$spc$yy";
329 $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy";
333 $main::lxdebug->leave_sub();
339 $main::lxdebug->enter_sub(2);
341 my ($self, $myconfig, $date, $longformat) = @_;
342 my ($spc, $yy, $mm, $dd);
345 $main::lxdebug->leave_sub(2);
350 $spc = $myconfig->{dateformat};
352 $spc = substr($spc, 1, 1);
355 if ($myconfig->{dateformat} =~ /^yy/) {
356 ($yy, $mm, $dd) = split /\D/, $date;
357 } elsif ($myconfig->{dateformat} =~ /^mm/) {
358 ($mm, $dd, $yy) = split /\D/, $date;
359 } elsif ($myconfig->{dateformat} =~ /^dd/) {
360 ($dd, $mm, $yy) = split /\D/, $date;
363 $date = substr($date, 2);
364 ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
367 $_ ||= 0 for ($dd, $mm, $yy);
368 $_ *= 1 for ($dd, $mm, $yy);
369 $yy = ($yy < 70) ? $yy + 2000 : $yy;
370 $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
372 $main::lxdebug->leave_sub(2);
373 return ($yy, $mm, $dd);
376 sub parse_date_to_object {
377 my ($self, $string, %params) = @_;
379 return undef if !defined $string;
381 $params{dateformat} ||= $::myconfig{dateformat} || 'yy-mm-dd';
382 $params{numberformat} ||= $::myconfig{numberformat} || '1,000.00';
383 my $num_separator = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
385 my ($date_str, $time_str) = split m{\s+}, $string, 2;
386 my ($yy, $mm, $dd) = $self->parse_date(\%params, $date_str);
388 my ($hour, $minute, $second) = split m/:/, ($time_str || '');
391 ($second, my $millisecond) = split quotemeta($num_separator), $second, 2;
392 $_ ||= 0 for ($hour, $minute, $millisecond);
394 $millisecond = substr $millisecond, 0, 3;
395 $millisecond .= '0' x (3 - length $millisecond);
397 return undef unless $yy && $mm && $dd;
398 return DateTime->new(year => $yy, month => $mm, day => $dd, hour => $hour * 1, minute => $minute * 1, second => $second * 1, nanosecond => $millisecond * 1000000);
401 sub format_date_object_to_time {
402 my ($self, $datetime, %params) = @_;
404 my $format = $::myconfig{timeformat} || 'hh:mm';
405 $format =~ s/hh/\%H/;
406 $format =~ s/mm/\%M/;
407 $format =~ s/ss/\%S/;
409 return $datetime->strftime($format);
412 sub format_date_object {
413 my ($self, $datetime, %params) = @_;
415 my $format = $params{dateformat} || $::myconfig{dateformat} || 'yyyy-mm-dd';
416 my $num_separator = ($params{numberformat} || $::myconfig{numberformat} || '1,000.00') =~ m{,\d+$} ? ',' : '.';
417 $format =~ s/yy(?:yy)?/\%Y/;
418 $format =~ s/mm/\%m/;
419 $format =~ s/dd/\%d/;
421 my $precision = $params{precision} || 'day';
422 $precision =~ s/s$//;
423 my %precision_spec_map = (
424 millisecond => '%H:%M:%S' . $num_separator . '%3N',
425 second => '%H:%M:%S',
430 $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
432 return $datetime->strftime($format);
436 $main::lxdebug->enter_sub(2);
438 my ($self, $myconfig, $date, $output_format, $longformat) = @_;
440 $main::lxdebug->leave_sub(2) and return "" unless ($date);
442 my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
444 $output_format =~ /d+/;
445 substr($output_format, $-[0], $+[0] - $-[0]) =
446 sprintf("%0" . (length($&)) . "d", $dd);
448 $output_format =~ /m+/;
449 substr($output_format, $-[0], $+[0] - $-[0]) =
450 sprintf("%0" . (length($&)) . "d", $mm);
452 $output_format =~ /y+/;
453 substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
455 $main::lxdebug->leave_sub(2);
457 return $output_format;
461 $main::lxdebug->enter_sub();
464 my $myconfig = shift;
468 my $yy_len = shift || 4;
470 ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
472 $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
474 $yy = $yy % 100 if 2 == $yy_len;
476 my $format = ref $myconfig eq '' ? "$myconfig" : $myconfig->{dateformat};
477 $format =~ s{ d+ }{ sprintf("%0" . (length($&)) . "d", $dd) }gex;
478 $format =~ s{ m+ }{ sprintf("%0" . (length($&)) . "d", $mm) }gex;
479 $format =~ s{ y+ }{ sprintf("%0${yy_len}d", $yy) }gex;
481 $main::lxdebug->leave_sub();
486 sub quote_special_chars {
488 my $format = lc shift;
491 if ($self->{special_chars_map} && $self->{special_chars_map}->{$format} && $self->{special_chars_map}->{$format}->{order}) {
492 my $scmap = $self->{special_chars_map}->{$format};
494 map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
500 sub unquote_special_chars {
504 return $self->quote_special_chars("${format}-reverse", shift);
507 sub remap_special_chars {
509 my $src_format = shift;
510 my $dst_format = shift;
512 return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
518 return !!$self->{raw_io_active};
526 $self->{raw_io_active} = 1;
529 binmode $fh, ":utf8";
530 $self->{raw_io_active} = 0;
533 sub set_numberformat_wo_thousands_separator {
535 my $myconfig = shift || \%::myconfig;
537 $self->{saved_numberformat} = $myconfig->{numberformat};
538 $myconfig->{numberformat} =~ s/^1[,\.]/1/;
541 sub restore_numberformat {
543 my $myconfig = shift || \%::myconfig;
545 $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
548 sub get_local_time_zone {
550 $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
551 return $self->{local_time_zone};
555 my ($self, $items, %params) = @_;
558 $params{conjunction} ||= $::locale->text('and');
559 my $num = scalar @{ $items };
561 return 0 == $num ? ''
562 : 1 == $num ? $items->[0]
563 : join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
576 Locale - Functions for dealing with locale-dependent information
583 my $locale = Locale->new('de');
584 my $now = DateTime->now_local;
585 print "Current date and time: ", $::locale->format_date_object($now, precision => 'second'), "\n";
601 TODO: Describe findsub
605 TODO: Describe format_date
607 =item C<format_date_object $datetime, %params>
609 Formats the C<$datetime> object accoring to the user's locale setting.
611 The parameter C<precision> can control whether or not the time
612 component is formatted as well:
618 Only format the year, month and day. This is also the default.
622 Add the hour to the date.
626 Add hour:minute to the date.
630 Add hour:minute:second to the date.
632 =item * C<millisecond>
634 Add hour:minute:second.millisecond to the date. The decimal separator
635 is derived from the number format.
637 =item * C<numberformat>
639 The number format to use, e.g. C<1,000.00>. If unset the user's
640 current number format is used.
642 =item * C<dateformat>
644 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
649 =item C<get_local_time_zone>
651 TODO: Describe get_local_time_zone
653 =item C<lang_to_locale>
655 TODO: Describe lang_to_locale
663 TODO: Describe parse_date
665 =item C<parse_date_to_object $string, %params>
667 Parses a date and optional timestamp in C<$string> and returns an
668 instance of L<DateTime>. The date and number formats used are the ones
669 the user has currently selected. They can be overriden by passing them
670 in as parameters to this function, though.
672 The time stamps can have up to millisecond precision.
674 =item C<quote_special_chars>
676 TODO: Describe quote_special_chars
678 =item C<raw_io_active>
680 TODO: Describe raw_io_active
682 =item C<reformat_date>
684 TODO: Describe reformat_date
686 =item C<remap_special_chars>
688 TODO: Describe remap_special_chars
690 =item C<restore_numberformat>
692 TODO: Describe restore_numberformat
694 =item C<set_numberformat_wo_thousands_separator>
696 TODO: Describe set_numberformat_wo_thousands_separator
702 =item C<unquote_special_chars>
704 TODO: Describe unquote_special_chars
708 TODO: Describe with_raw_io
718 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>