countries defaults managed
[kivitendo-erp.git] / SL / Locale.pm
1 #====================================================================
2 # LX-Office ERP
3 # Copyright (C) 2004
4 # Based on SQL-Ledger Version 2.1.9
5 # Web http://www.lx-office.org
6 #
7 #=====================================================================
8 # SQL-Ledger Accounting
9 # Copyright (C) 1998-2002
10 #
11 #  Author: Dieter Simader
12 #   Email: dsimader@sql-ledger.org
13 #     Web: http://www.sql-ledger.org
14 #
15 # Contributors: Thomas Bayen <bayen@gmx.de>
16 #               Antti Kaihola <akaihola@siba.fi>
17 #               Moritz Bunkus (tex code)
18 #
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.
23 #
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 #======================================================================
32 #
33 # Translations and number/date formatting
34 #
35 #======================================================================
36
37 package Locale;
38
39 use DateTime;
40 use Encode;
41 use List::Util qw(first);
42 use List::MoreUtils qw(any);
43
44 use SL::LXDebug;
45 use SL::Common;
46 use SL::Iconv;
47 use SL::Inifile;
48 use XML::LibXML;
49
50 use strict;
51
52 my %locales_by_language;
53
54 sub new {
55   $main::lxdebug->enter_sub();
56
57   my ($type, $language) = @_;
58
59   $language ||= $::lx_office_conf{system}->{language};
60   $language   =~ s|.*/||;
61   $language   =~ s|\.||g;
62
63   if (!$locales_by_language{$language}) {
64     my $self = {};
65     bless $self, $type;
66
67     $self->_init($language);
68
69     $locales_by_language{$language} = $self;
70   }
71
72   $main::lxdebug->leave_sub();
73
74   return $locales_by_language{$language}
75 }
76
77 sub _init {
78   my $self     = shift;
79   my $language  = shift;
80
81   $self->{countrycode} = $language;
82
83   if ($language && -d "locale/$language") {
84     local *IN;
85     if (open(IN, "<", "locale/$language/all")) {
86       my $code = join("", <IN>);
87       eval($code);
88       close(IN);
89     }
90
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;
94       close $dh;
95
96       for my $file (@files) {
97         if (open my $in, "<", "locale/$language/more/$file") {
98           local $/ = undef;
99           my $code = <$in>;
100           eval($code);
101           close($in);
102           $self->{texts}{$_} = $self->{more_texts}{$_} for keys %{ $self->{more_texts} };
103         }
104       }
105     }
106   }
107
108   binmode STDOUT, ":utf8";
109   binmode STDERR, ":utf8";
110
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');
117
118   $self->_read_special_chars_file($language);
119
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));
126 }
127
128 sub _handle_markup {
129   my $self    = shift;
130   my $str     = shift;
131
132   my $escaped = 0;
133   my $new_str = '';
134
135   for (my $i = 0; $i < length $str; $i++) {
136     my $char = substr $str, $i, 1;
137
138     if ($escaped) {
139       if ($char eq 'n') {
140         $new_str .= "\n";
141
142       } elsif ($char eq 'r') {
143         $new_str .= "\r";
144
145       } elsif ($char eq 's') {
146         $new_str .= ' ';
147
148       } elsif ($char eq 'x') {
149         $new_str .= chr(hex(substr($str, $i + 1, 2)));
150         $i       += 2;
151
152       } else {
153         $new_str .= $char;
154       }
155
156       $escaped  = 0;
157
158     } elsif ($char eq '\\') {
159       $escaped  = 1;
160
161     } else {
162       $new_str .= $char;
163     }
164   }
165
166   return $new_str;
167 }
168
169 sub _read_special_chars_file {
170   my $self    = shift;
171   my $language = shift;
172
173   if (! -f "locale/$language/special_chars") {
174     $self->{special_chars_map} = {};
175     return;
176   }
177
178   $self->{special_chars_map} = Inifile->new("locale/$language/special_chars", 'verbatim' => 1);
179
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'));
182
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;
187     }
188
189     my $scmap = $self->{special_chars_map}->{$format};
190     my $order = $self->{iconv}->convert($scmap->{order});
191     delete $scmap->{order};
192
193     foreach my $key (keys %{ $scmap }) {
194       $scmap->{$key} = $self->_handle_markup($self->{iconv}->convert($scmap->{$key}));
195
196       my $new_key    = $self->_handle_markup($self->{iconv}->convert($key));
197
198       if ($key ne $new_key) {
199         $scmap->{$new_key} = $scmap->{$key};
200         delete $scmap->{$key};
201       }
202     }
203
204     $self->{special_chars_map}->{"${format}-reverse"}          = { reverse %{ $scmap } };
205
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} } ];
208   }
209 }
210
211 sub text {
212   my $self = shift;
213   my $text = shift;
214
215   return $text->translated if (ref($text) || '') eq 'SL::Locale::String';
216
217   if ($self->{texts}->{$text}) {
218     $text = $self->{iconv}->convert($self->{texts}->{$text});
219   } else {
220     $text = $self->{iconv_english}->convert($text);
221   }
222
223   if (@_) {
224     $text = Form->format_string($text, @_);
225   }
226
227   return $text;
228 }
229
230 sub lang_to_locale {
231   my ($self, $requested_lang) = @_;
232
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';
238
239   return $requested_locale;
240 }
241
242 sub findsub {
243   $main::lxdebug->enter_sub();
244
245   my ($self, $text) = @_;
246   my $text_rev      = lc $self->{iconv_reverse}->convert($text);
247   $text_rev         =~ s/[\s\-]+/_/g;
248
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;
255
256       $translation =  lc $translation;
257       $translation =~ s/[\s\-]+/_/g;
258
259       $self->{texts_reverse}->{$translation} ||= [ ];
260       push @{ $self->{texts_reverse}->{$translation} }, $original;
261     }
262   }
263
264   my $sub_name;
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}" };
267
268   $main::form->error("$text not defined in locale/$self->{countrycode}/all") if !$sub_name;
269
270   $main::lxdebug->leave_sub();
271
272   return $sub_name;
273 }
274
275 sub date {
276   $main::lxdebug->enter_sub();
277
278   my ($self, $myconfig, $date, $longformat) = @_;
279
280   if (!$date) {
281     $main::lxdebug->leave_sub();
282     return '';
283   }
284
285   my $longdate  = "";
286   my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
287
288   my ($spc, $yy, $mm, $dd);
289
290     # get separator
291   $spc = $myconfig->{dateformat};
292   $spc =~ s/\w//g;
293   $spc = substr($spc, 1, 1);
294
295   if ($date =~ /\D/) {
296     if ($myconfig->{dateformat} =~ /^yy/) {
297       ($yy, $mm, $dd) = split /\D/, $date;
298     }
299     if ($myconfig->{dateformat} =~ /^mm/) {
300       ($mm, $dd, $yy) = split /\D/, $date;
301     }
302     if ($myconfig->{dateformat} =~ /^dd/) {
303       ($dd, $mm, $yy) = split /\D/, $date;
304     }
305   } else {
306     $date = substr($date, 2);
307     ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
308   }
309
310   $dd *= 1;
311   $mm--;
312   $yy = ($yy < 70) ? $yy + 2000 : $yy;
313   $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
314
315   if ($myconfig->{dateformat} =~ /^dd/) {
316     if (defined $longformat && $longformat == 0) {
317       $mm++;
318       $dd = "0$dd" if ($dd < 10);
319       $mm = "0$mm" if ($mm < 10);
320       $longdate = "$dd$spc$mm$spc$yy";
321     } else {
322       $longdate = "$dd";
323       $longdate .= ($spc eq '.') ? ". " : " ";
324       $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
325     }
326   } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") {
327
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) {
331       $mm++;
332       $dd = "0$dd" if ($dd < 10);
333       $mm = "0$mm" if ($mm < 10);
334       $longdate = "$yy-$mm-$dd";
335     } else {
336       $longdate = "$dd. ";
337       $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
338     }
339   } else {
340     if (defined $longformat && $longformat == 0) {
341       $mm++;
342       $dd = "0$dd" if ($dd < 10);
343       $mm = "0$mm" if ($mm < 10);
344       $longdate = "$mm$spc$dd$spc$yy";
345     } else {
346       $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy";
347     }
348   }
349
350   $main::lxdebug->leave_sub();
351
352   return $longdate;
353 }
354
355 sub parse_date {
356   $main::lxdebug->enter_sub(2);
357
358   my ($self, $myconfig, $date, $longformat) = @_;
359   my ($spc, $yy, $mm, $dd);
360
361   unless ($date) {
362     $main::lxdebug->leave_sub(2);
363     return ();
364   }
365
366   # get separator
367   $spc = $myconfig->{dateformat};
368   $spc =~ s/\w//g;
369   $spc = substr($spc, 1, 1);
370
371   if ($date =~ /\D/) {
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;
378     }
379   } else {
380     $date = substr($date, 2);
381     ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
382   }
383
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;
388
389   $main::lxdebug->leave_sub(2);
390   return ($yy, $mm, $dd);
391 }
392
393 sub parse_date_to_object {
394   my ($self, $string, %params) = @_;
395
396   return undef if !defined $string;
397
398   $params{dateformat}        ||= $::myconfig{dateformat}   || 'yy-mm-dd';
399   $params{numberformat}      ||= $::myconfig{numberformat} || '1,000.00';
400   my $num_separator            = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
401
402   my ($date_str, $time_str)    = split m{\s+}, $string, 2;
403   my ($yy, $mm, $dd)           = $self->parse_date(\%params, $date_str);
404
405   my ($hour, $minute, $second) = split m/:/, ($time_str || '');
406   $second ||= '0';
407
408   ($second, my $millisecond)   = split quotemeta($num_separator), $second, 2;
409   $_ ||= 0 for ($hour, $minute, $millisecond);
410
411   $millisecond                 = substr $millisecond, 0, 3;
412   $millisecond                .= '0' x (3 - length $millisecond);
413
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);
416 }
417
418 sub format_date_object_to_time {
419   my ($self, $datetime, %params) = @_;
420
421   my $format =  $::myconfig{timeformat} || 'hh:mm';
422   $format    =~ s/hh/\%H/;
423   $format    =~ s/mm/\%M/;
424   $format    =~ s/ss/\%S/;
425
426   return $datetime->strftime($format);
427 }
428
429 sub format_date_object {
430   my ($self, $datetime, %params)    = @_;
431
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/;
437
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',
443     minute      => '%H:%M',
444     hour        => '%H',
445   );
446
447   $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
448
449   return $datetime->strftime($format);
450 }
451
452 sub reformat_date {
453   $main::lxdebug->enter_sub(2);
454
455   my ($self, $myconfig, $date, $output_format, $longformat) = @_;
456
457   $main::lxdebug->leave_sub(2) and return "" unless ($date);
458
459   my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
460
461   $output_format =~ /(d+)/;
462   substr($output_format, $-[0], $+[0] - $-[0]) =
463     sprintf("%0" . (length($1)) . "d", $dd);
464
465   $output_format =~ /(m+)/;
466   substr($output_format, $-[0], $+[0] - $-[0]) =
467     sprintf("%0" . (length($1)) . "d", $mm);
468
469   $output_format =~ /y+/;
470   substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
471
472   $main::lxdebug->leave_sub(2);
473
474   return $output_format;
475 }
476
477 sub format_date {
478   $main::lxdebug->enter_sub();
479
480   my $self     = shift;
481   my $myconfig = shift;
482   my $yy       = shift;
483   my $mm       = shift;
484   my $dd       = shift;
485   my $yy_len   = shift || 4;
486
487   ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
488
489   $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
490
491   $yy = $yy % 100 if 2 == $yy_len;
492
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;
497
498   $main::lxdebug->leave_sub();
499
500   return $format;
501 }
502
503 sub quote_special_chars {
504   my $self   = shift;
505   my $format = lc shift;
506   my $string = shift;
507
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};
510
511     map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
512   }
513
514   return $string;
515 }
516
517 sub unquote_special_chars {
518   my $self    = shift;
519   my $format  = shift;
520
521   return $self->quote_special_chars("${format}-reverse", shift);
522 }
523
524 sub remap_special_chars {
525   my $self       = shift;
526   my $src_format = shift;
527   my $dst_format = shift;
528
529   return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
530 }
531
532 sub raw_io_active {
533   my $self = shift;
534
535   return !!$self->{raw_io_active};
536 }
537
538 sub with_raw_io {
539   my $self = shift;
540   my $fh   = shift;
541   my $code = shift;
542
543   $self->{raw_io_active} = 1;
544   binmode $fh, ":raw";
545   $code->();
546   binmode $fh, ":utf8";
547   $self->{raw_io_active} = 0;
548 }
549
550 sub set_numberformat_wo_thousands_separator {
551   my $self     = shift;
552   my $myconfig = shift || \%::myconfig;
553
554   $self->{saved_numberformat} = $myconfig->{numberformat};
555   $myconfig->{numberformat}   =~ s/^1[,\.]/1/;
556 }
557
558 sub restore_numberformat {
559   my $self     = shift;
560   my $myconfig = shift || \%::myconfig;
561
562   $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
563 }
564
565 sub get_local_time_zone {
566   my $self = shift;
567   $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
568   return $self->{local_time_zone};
569 }
570
571 sub language_join {
572   my ($self, $items, %params) = @_;
573
574   $items               ||= [];
575   $params{conjunction} ||= $::locale->text('and');
576   my $num                = scalar @{ $items };
577
578   return 0 == $num ? ''
579        : 1 == $num ? $items->[0]
580        :             join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
581 }
582
583 1;
584
585 __END__
586
587 =pod
588
589 =encoding utf8
590
591 =head1 NAME
592
593 Locale - Functions for dealing with locale-dependent information
594
595 =head1 SYNOPSIS
596
597   use Locale;
598   use DateTime;
599
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";
603
604 =head1 OVERVIEW
605
606 TODO: write overview
607
608 =head1 FUNCTIONS
609
610 =over 4
611
612 =item C<date>
613
614 TODO: Describe date
615
616 =item C<findsub>
617
618 TODO: Describe findsub
619
620 =item C<format_date>
621
622 TODO: Describe format_date
623
624 =item C<format_date_object $datetime, %params>
625
626 Formats the C<$datetime> object accoring to the user's locale setting.
627
628 The parameter C<precision> can control whether or not the time
629 component is formatted as well:
630
631 =over 4
632
633 =item * C<day>
634
635 Only format the year, month and day. This is also the default.
636
637 =item * C<hour>
638
639 Add the hour to the date.
640
641 =item * C<minute>
642
643 Add hour:minute to the date.
644
645 =item * C<second>
646
647 Add hour:minute:second to the date.
648
649 =item * C<millisecond>
650
651 Add hour:minute:second.millisecond to the date. The decimal separator
652 is derived from the number format.
653
654 =item * C<numberformat>
655
656 The number format to use, e.g. C<1,000.00>. If unset the user's
657 current number format is used.
658
659 =item * C<dateformat>
660
661 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
662 date format is used.
663
664 =back
665
666 =item C<get_local_time_zone>
667
668 TODO: Describe get_local_time_zone
669
670 =item C<lang_to_locale>
671
672 TODO: Describe lang_to_locale
673
674 =item C<new>
675
676 TODO: Describe new
677
678 =item C<parse_date>
679
680 TODO: Describe parse_date
681
682 =item C<parse_date_to_object $string, %params>
683
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.
688
689 The time stamps can have up to millisecond precision.
690
691 =item C<quote_special_chars>
692
693 TODO: Describe quote_special_chars
694
695 =item C<raw_io_active>
696
697 TODO: Describe raw_io_active
698
699 =item C<reformat_date>
700
701 TODO: Describe reformat_date
702
703 =item C<remap_special_chars>
704
705 TODO: Describe remap_special_chars
706
707 =item C<restore_numberformat>
708
709 TODO: Describe restore_numberformat
710
711 =item C<set_numberformat_wo_thousands_separator>
712
713 TODO: Describe set_numberformat_wo_thousands_separator
714
715 =item C<text>
716
717 TODO: Describe text
718
719 =item C<unquote_special_chars>
720
721 TODO: Describe unquote_special_chars
722
723 =item C<with_raw_io>
724
725 TODO: Describe with_raw_io
726
727 =back
728
729 =head1 BUGS
730
731 Nothing here yet.
732
733 =head1 AUTHOR
734
735 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
736
737 =cut