doc/ Trigram Erweiterung als Musskriterium für das Upgrade genannt
[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., 51 Franklin Street, Fifth Floor, Boston,
31 # MA 02110-1335, USA.
32 #======================================================================
33 #
34 # Translations and number/date formatting
35 #
36 #======================================================================
37
38 package Locale;
39
40 use DateTime;
41 use Encode;
42 use List::Util qw(first);
43 use List::MoreUtils qw(any);
44
45 use SL::LXDebug;
46 use SL::Common;
47 use SL::Iconv;
48 use SL::Inifile;
49
50 use strict;
51
52 my %locales_by_country;
53
54 sub new {
55   $main::lxdebug->enter_sub();
56
57   my ($type, $country) = @_;
58
59   $country ||= $::lx_office_conf{system}->{language};
60   $country   =~ s|.*/||;
61   $country   =~ s|\.||g;
62
63   if (!$locales_by_country{$country}) {
64     my $self = {};
65     bless $self, $type;
66
67     $self->_init($country);
68
69     $locales_by_country{$country} = $self;
70   }
71
72   $main::lxdebug->leave_sub();
73
74   return $locales_by_country{$country}
75 }
76
77 sub _init {
78   my $self     = shift;
79   my $country  = shift;
80
81   $self->{countrycode} = $country;
82
83   if ($country && -d "locale/$country") {
84     if (open my $in, "<", "locale/$country/all") {
85       local $/ = undef;
86       my $code = <$in>;
87       eval($code);
88       close($in);
89     }
90
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;
94       close $dh;
95
96       for my $file (@files) {
97         if (open my $in, "<", "locale/$country/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($country);
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 $country = shift;
172
173   if (! -f "locale/$country/special_chars") {
174     $self->{special_chars_map} = {};
175     return;
176   }
177
178   $self->{special_chars_map} = Inifile->new("locale/$country/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   return DateTime->today_local                      if lc($string) eq 'today';
399   return DateTime->today_local->subtract(days => 1) if lc($string) eq 'yesterday';
400
401   $params{dateformat}        ||= $::myconfig{dateformat}   || 'yy-mm-dd';
402   $params{numberformat}      ||= $::myconfig{numberformat} || '1,000.00';
403   my $num_separator            = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
404
405   my ($date_str, $time_str)    = split m{\s+}, $string, 2;
406   my ($yy, $mm, $dd)           = $self->parse_date(\%params, $date_str);
407
408   my ($hour, $minute, $second) = split m/:/, ($time_str || '');
409   $second ||= '0';
410
411   ($second, my $millisecond)   = split quotemeta($num_separator), $second, 2;
412   $_ ||= 0 for ($hour, $minute, $millisecond);
413
414   $millisecond                 = substr $millisecond, 0, 3;
415   $millisecond                .= '0' x (3 - length $millisecond);
416
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);
419 }
420
421 sub format_date_object_to_time {
422   my ($self, $datetime, %params) = @_;
423
424   my $format =  $::myconfig{timeformat} || 'hh:mm';
425   $format    =~ s/hh/\%H/;
426   $format    =~ s/mm/\%M/;
427   $format    =~ s/ss/\%S/;
428
429   return $datetime->strftime($format);
430 }
431
432 sub format_date_object {
433   my ($self, $datetime, %params)    = @_;
434
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/;
440
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',
446     minute      => '%H:%M',
447     hour        => '%H',
448   );
449
450   $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
451
452   return $datetime->strftime($format);
453 }
454
455 sub reformat_date {
456   $main::lxdebug->enter_sub(2);
457
458   my ($self, $myconfig, $date, $output_format, $longformat) = @_;
459
460   $main::lxdebug->leave_sub(2) and return "" unless ($date);
461
462   my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
463
464   $output_format =~ /(d+)/;
465   substr($output_format, $-[0], $+[0] - $-[0]) =
466     sprintf("%0" . (length($1)) . "d", $dd);
467
468   $output_format =~ /(m+)/;
469   substr($output_format, $-[0], $+[0] - $-[0]) =
470     sprintf("%0" . (length($1)) . "d", $mm);
471
472   $output_format =~ /y+/;
473   substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
474
475   $main::lxdebug->leave_sub(2);
476
477   return $output_format;
478 }
479
480 sub format_date {
481   $main::lxdebug->enter_sub();
482
483   my $self     = shift;
484   my $myconfig = shift;
485   my $yy       = shift;
486   my $mm       = shift;
487   my $dd       = shift;
488   my $yy_len   = shift || 4;
489
490   ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
491
492   $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
493
494   $yy = $yy % 100 if 2 == $yy_len;
495
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;
500
501   $main::lxdebug->leave_sub();
502
503   return $format;
504 }
505
506 sub quote_special_chars {
507   my $self   = shift;
508   my $format = lc shift;
509   my $string = shift;
510
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};
513
514     map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
515   }
516
517   return $string;
518 }
519
520 sub unquote_special_chars {
521   my $self    = shift;
522   my $format  = shift;
523
524   return $self->quote_special_chars("${format}-reverse", shift);
525 }
526
527 sub remap_special_chars {
528   my $self       = shift;
529   my $src_format = shift;
530   my $dst_format = shift;
531
532   return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
533 }
534
535 sub raw_io_active {
536   my $self = shift;
537
538   return !!$self->{raw_io_active};
539 }
540
541 sub with_raw_io {
542   my $self = shift;
543   my $fh   = shift;
544   my $code = shift;
545
546   $self->{raw_io_active} = 1;
547   binmode $fh, ":raw";
548   $code->();
549   binmode $fh, ":utf8";
550   $self->{raw_io_active} = 0;
551 }
552
553 sub set_numberformat_wo_thousands_separator {
554   my $self     = shift;
555   my $myconfig = shift || \%::myconfig;
556
557   $self->{saved_numberformat} = $myconfig->{numberformat};
558   $myconfig->{numberformat}   =~ s/^1[,\.]/1/;
559 }
560
561 sub restore_numberformat {
562   my $self     = shift;
563   my $myconfig = shift || \%::myconfig;
564
565   $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
566 }
567
568 sub get_local_time_zone {
569   my $self = shift;
570   $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
571   return $self->{local_time_zone};
572 }
573
574 sub language_join {
575   my ($self, $items, %params) = @_;
576
577   $items               ||= [];
578   $params{conjunction} ||= $::locale->text('and');
579   my $num                = scalar @{ $items };
580
581   return 0 == $num ? ''
582        : 1 == $num ? $items->[0]
583        :             join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
584 }
585
586 1;
587
588 __END__
589
590 =pod
591
592 =encoding utf8
593
594 =head1 NAME
595
596 Locale - Functions for dealing with locale-dependent information
597
598 =head1 SYNOPSIS
599
600   use Locale;
601   use DateTime;
602
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";
606
607 =head1 OVERVIEW
608
609 TODO: write overview
610
611 =head1 FUNCTIONS
612
613 =over 4
614
615 =item C<date>
616
617 TODO: Describe date
618
619 =item C<findsub>
620
621 TODO: Describe findsub
622
623 =item C<format_date>
624
625 TODO: Describe format_date
626
627 =item C<format_date_object $datetime, %params>
628
629 Formats the C<$datetime> object according to the user's locale setting.
630
631 The parameter C<precision> can control whether or not the time
632 component is formatted as well:
633
634 =over 4
635
636 =item * C<day>
637
638 Only format the year, month and day. This is also the default.
639
640 =item * C<hour>
641
642 Add the hour to the date.
643
644 =item * C<minute>
645
646 Add hour:minute to the date.
647
648 =item * C<second>
649
650 Add hour:minute:second to the date.
651
652 =item * C<millisecond>
653
654 Add hour:minute:second.millisecond to the date. The decimal separator
655 is derived from the number format.
656
657 =item * C<numberformat>
658
659 The number format to use, e.g. C<1,000.00>. If unset the user's
660 current number format is used.
661
662 =item * C<dateformat>
663
664 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
665 date format is used.
666
667 =back
668
669 =item C<get_local_time_zone>
670
671 TODO: Describe get_local_time_zone
672
673 =item C<lang_to_locale>
674
675 TODO: Describe lang_to_locale
676
677 =item C<new>
678
679 TODO: Describe new
680
681 =item C<parse_date>
682
683 TODO: Describe parse_date
684
685 =item C<parse_date_to_object $string, %params>
686
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.
691
692 The time stamps can have up to millisecond precision.
693
694 =item C<quote_special_chars>
695
696 TODO: Describe quote_special_chars
697
698 =item C<raw_io_active>
699
700 TODO: Describe raw_io_active
701
702 =item C<reformat_date>
703
704 TODO: Describe reformat_date
705
706 =item C<remap_special_chars>
707
708 TODO: Describe remap_special_chars
709
710 =item C<restore_numberformat>
711
712 TODO: Describe restore_numberformat
713
714 =item C<set_numberformat_wo_thousands_separator>
715
716 TODO: Describe set_numberformat_wo_thousands_separator
717
718 =item C<text>
719
720 TODO: Describe text
721
722 =item C<unquote_special_chars>
723
724 TODO: Describe unquote_special_chars
725
726 =item C<with_raw_io>
727
728 TODO: Describe with_raw_io
729
730 =back
731
732 =head1 BUGS
733
734 Nothing here yet.
735
736 =head1 AUTHOR
737
738 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
739
740 =cut