epic-s6ts
[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 is_supported {
78   my ($country) = @_;
79
80   return -f "locale/$country/all";
81 }
82
83 sub _init {
84   my $self     = shift;
85   my $country  = shift;
86
87   $self->{countrycode} = $country;
88
89   if ($country && -d "locale/$country") {
90     if (open my $in, "<", "locale/$country/all") {
91       local $/ = undef;
92       my $code = <$in>;
93       eval($code);
94       close($in);
95     }
96
97     if (-d "locale/$country/more") {
98       opendir my $dh, "locale/$country/more" or die "can't open locale/$country/more: $!";
99       my @files = sort grep -f "locale/$country/more/$_", readdir $dh;
100       close $dh;
101
102       for my $file (@files) {
103         if (open my $in, "<", "locale/$country/more/$file") {
104           local $/ = undef;
105           my $code = <$in>;
106           eval($code);
107           close($in);
108           $self->{texts}{$_} = $self->{more_texts}{$_} for keys %{ $self->{more_texts} };
109         }
110       }
111     }
112   }
113
114   binmode STDOUT, ":utf8";
115   binmode STDERR, ":utf8";
116
117   $self->{iconv}            = SL::Iconv->new('UTF-8',       'UTF-8');
118   $self->{iconv_reverse}    = SL::Iconv->new('UTF-8',       'UTF-8');
119   $self->{iconv_english}    = SL::Iconv->new('ASCII',       'UTF-8');
120   $self->{iconv_iso8859}    = SL::Iconv->new('ISO-8859-15', 'UTF-8');
121   $self->{iconv_to_iso8859} = SL::Iconv->new('UTF-8',       'ISO-8859-15');
122   $self->{iconv_utf8}       = SL::Iconv->new('UTF-8',       'UTF-8');
123
124   $self->_read_special_chars_file($country);
125
126   push @{ $self->{LONG_MONTH} },
127     ("January",   "February", "March",    "April",
128      "May ",      "June",     "July",     "August",
129      "September", "October",  "November", "December");
130   push @{ $self->{SHORT_MONTH} },
131     (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
132 }
133
134 sub _handle_markup {
135   my $self    = shift;
136   my $str     = shift;
137
138   my $escaped = 0;
139   my $new_str = '';
140
141   for (my $i = 0; $i < length $str; $i++) {
142     my $char = substr $str, $i, 1;
143
144     if ($escaped) {
145       if ($char eq 'n') {
146         $new_str .= "\n";
147
148       } elsif ($char eq 'r') {
149         $new_str .= "\r";
150
151       } elsif ($char eq 's') {
152         $new_str .= ' ';
153
154       } elsif ($char eq 'x') {
155         $new_str .= chr(hex(substr($str, $i + 1, 2)));
156         $i       += 2;
157
158       } else {
159         $new_str .= $char;
160       }
161
162       $escaped  = 0;
163
164     } elsif ($char eq '\\') {
165       $escaped  = 1;
166
167     } else {
168       $new_str .= $char;
169     }
170   }
171
172   return $new_str;
173 }
174
175 sub _read_special_chars_file {
176   my $self    = shift;
177   my $country = shift;
178
179   if (! -f "locale/$country/special_chars") {
180     $self->{special_chars_map} = {};
181     return;
182   }
183
184   $self->{special_chars_map} = Inifile->new("locale/$country/special_chars", 'verbatim' => 1);
185
186   foreach my $format (keys %{ $self->{special_chars_map} }) {
187     next if (($format eq 'FILE') || ($format eq 'ORDER') || (ref $self->{special_chars_map}->{$format} ne 'HASH'));
188
189     if ($format ne lc $format) {
190       $self->{special_chars_map}->{lc $format} = $self->{special_chars_map}->{$format};
191       delete $self->{special_chars_map}->{$format};
192       $format = lc $format;
193     }
194
195     my $scmap = $self->{special_chars_map}->{$format};
196     my $order = $self->{iconv}->convert($scmap->{order});
197     delete $scmap->{order};
198
199     foreach my $key (keys %{ $scmap }) {
200       $scmap->{$key} = $self->_handle_markup($self->{iconv}->convert($scmap->{$key}));
201
202       my $new_key    = $self->_handle_markup($self->{iconv}->convert($key));
203
204       if ($key ne $new_key) {
205         $scmap->{$new_key} = $scmap->{$key};
206         delete $scmap->{$key};
207       }
208     }
209
210     $self->{special_chars_map}->{"${format}-reverse"}          = { reverse %{ $scmap } };
211
212     $scmap->{order}                                            = [ map { $self->_handle_markup($_) } split m/\s+/, $order ];
213     $self->{special_chars_map}->{"${format}-reverse"}->{order} = [ grep { $_ } map { $scmap->{$_} } reverse @{ $scmap->{order} } ];
214   }
215 }
216
217 sub text {
218   my $self = shift;
219   my $text = shift;
220
221   return $text->translated if (ref($text) || '') eq 'SL::Locale::String';
222
223   if ($self->{texts}->{$text}) {
224     $text = $self->{iconv}->convert($self->{texts}->{$text});
225   } else {
226     $text = $self->{iconv_english}->convert($text);
227   }
228
229   if (@_) {
230     $text = Form->format_string($text, @_);
231   }
232
233   return $text;
234 }
235
236 sub lang_to_locale {
237   my ($self, $requested_lang) = @_;
238
239   my $requested_locale;
240   $requested_locale = 'de' if $requested_lang =~ m/^_(de|deu|ger)/i;
241   $requested_locale = 'en' if $requested_lang =~ m/^_(en|uk|us|gr)/i;
242   $requested_locale = 'fr' if $requested_lang =~ m/^_fr/i;
243   $requested_locale ||= 'de';
244
245   return $requested_locale;
246 }
247
248 sub findsub {
249   $main::lxdebug->enter_sub();
250
251   my ($self, $text) = @_;
252   my $text_rev      = lc $self->{iconv_reverse}->convert($text);
253   $text_rev         =~ s/[\s\-]+/_/g;
254
255   if (!$self->{texts_reverse}) {
256     $self->{texts_reverse} = { };
257     while (my ($original, $translation) = each %{ $self->{texts} }) {
258       $original    =  lc $original;
259       $original    =~ s/[^a-z0-9]/_/g;
260       $original    =~ s/_+/_/g;
261
262       $translation =  lc $translation;
263       $translation =~ s/[\s\-]+/_/g;
264
265       $self->{texts_reverse}->{$translation} ||= [ ];
266       push @{ $self->{texts_reverse}->{$translation} }, $original;
267     }
268   }
269
270   my $sub_name;
271   $sub_name   = first { defined(&{ "::${_}" }) } @{ $self->{texts_reverse}->{$text_rev} } if $self->{texts_reverse}->{$text_rev};
272   $sub_name ||= $text_rev if ($text_rev =~ m/^[a-z][a-z0-9_]+$/) && defined &{ "::${text_rev}" };
273
274   $main::form->error("$text not defined in locale/$self->{countrycode}/all") if !$sub_name;
275
276   $main::lxdebug->leave_sub();
277
278   return $sub_name;
279 }
280
281 sub date {
282   $main::lxdebug->enter_sub();
283
284   my ($self, $myconfig, $date, $longformat) = @_;
285
286   if (!$date) {
287     $main::lxdebug->leave_sub();
288     return '';
289   }
290
291   my $longdate  = "";
292   my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
293
294   my ($spc, $yy, $mm, $dd);
295
296     # get separator
297   $spc = $myconfig->{dateformat};
298   $spc =~ s/\w//g;
299   $spc = substr($spc, 1, 1);
300
301   if ($date =~ /\D/) {
302     if ($myconfig->{dateformat} =~ /^yy/) {
303       ($yy, $mm, $dd) = split /\D/, $date;
304     }
305     if ($myconfig->{dateformat} =~ /^mm/) {
306       ($mm, $dd, $yy) = split /\D/, $date;
307     }
308     if ($myconfig->{dateformat} =~ /^dd/) {
309       ($dd, $mm, $yy) = split /\D/, $date;
310     }
311   } else {
312     $date = substr($date, 2);
313     ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
314   }
315
316   $dd *= 1;
317   $mm--;
318   $yy = ($yy < 70) ? $yy + 2000 : $yy;
319   $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
320
321   if ($myconfig->{dateformat} =~ /^dd/) {
322     if (defined $longformat && $longformat == 0) {
323       $mm++;
324       $dd = "0$dd" if ($dd < 10);
325       $mm = "0$mm" if ($mm < 10);
326       $longdate = "$dd$spc$mm$spc$yy";
327     } else {
328       $longdate = "$dd";
329       $longdate .= ($spc eq '.') ? ". " : " ";
330       $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
331     }
332   } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") {
333
334     # Use German syntax with the ISO date style "yyyy-mm-dd" because
335     # kivitendo is mainly used in Germany or German speaking countries.
336     if (defined $longformat && $longformat == 0) {
337       $mm++;
338       $dd = "0$dd" if ($dd < 10);
339       $mm = "0$mm" if ($mm < 10);
340       $longdate = "$yy-$mm-$dd";
341     } else {
342       $longdate = "$dd. ";
343       $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
344     }
345   } else {
346     if (defined $longformat && $longformat == 0) {
347       $mm++;
348       $dd = "0$dd" if ($dd < 10);
349       $mm = "0$mm" if ($mm < 10);
350       $longdate = "$mm$spc$dd$spc$yy";
351     } else {
352       $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy";
353     }
354   }
355
356   $main::lxdebug->leave_sub();
357
358   return $longdate;
359 }
360
361 sub parse_date {
362   $main::lxdebug->enter_sub(2);
363
364   my ($self, $myconfig, $date, $longformat) = @_;
365   my ($spc, $yy, $mm, $dd);
366
367   unless ($date) {
368     $main::lxdebug->leave_sub(2);
369     return ();
370   }
371
372   # get separator
373   $spc = $myconfig->{dateformat};
374   $spc =~ s/\w//g;
375   $spc = substr($spc, 1, 1);
376
377   if ($date =~ /\D/) {
378     if ($myconfig->{dateformat} =~ /^yy/) {
379       ($yy, $mm, $dd) = split /\D/, $date;
380     } elsif ($myconfig->{dateformat} =~ /^mm/) {
381       ($mm, $dd, $yy) = split /\D/, $date;
382     } elsif ($myconfig->{dateformat} =~ /^dd/) {
383       ($dd, $mm, $yy) = split /\D/, $date;
384     }
385   } else {
386     $date = substr($date, 2);
387     ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
388   }
389
390   $_ ||= 0 for ($dd, $mm, $yy);
391   $_ *= 1  for ($dd, $mm, $yy);
392   $yy = ($yy < 70) ? $yy + 2000 : $yy;
393   $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
394
395   $main::lxdebug->leave_sub(2);
396   return ($yy, $mm, $dd);
397 }
398
399 sub parse_date_to_object {
400   my ($self, $string, %params) = @_;
401
402   return undef if !defined $string;
403
404   return DateTime->today_local                      if lc($string) eq 'today';
405   return DateTime->today_local->subtract(days => 1) if lc($string) eq 'yesterday';
406
407   $params{dateformat}        ||= $::myconfig{dateformat}   || 'yy-mm-dd';
408   $params{numberformat}      ||= $::myconfig{numberformat} || '1,000.00';
409   my $num_separator            = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
410
411   my ($date_str, $time_str)    = split m{\s+}, $string, 2;
412   my ($yy, $mm, $dd)           = $self->parse_date(\%params, $date_str);
413
414   my ($hour, $minute, $second) = split m/:/, ($time_str || '');
415   $second ||= '0';
416
417   ($second, my $millisecond)   = split quotemeta($num_separator), $second, 2;
418   $_ ||= 0 for ($hour, $minute, $millisecond);
419
420   $millisecond                 = substr $millisecond, 0, 3;
421   $millisecond                .= '0' x (3 - length $millisecond);
422
423   return undef unless $yy && $mm && $dd;
424   return DateTime->new(year => $yy, month => $mm, day => $dd, hour => $hour * 1, minute => $minute * 1, second => $second * 1, nanosecond => $millisecond * 1000000);
425 }
426
427 sub format_date_object_to_time {
428   my ($self, $datetime, %params) = @_;
429
430   my $format =  $::myconfig{timeformat} || 'hh:mm';
431   $format    =~ s/hh/\%H/;
432   $format    =~ s/mm/\%M/;
433   $format    =~ s/ss/\%S/;
434
435   return $datetime->strftime($format);
436 }
437
438 sub format_date_object {
439   my ($self, $datetime, %params)    = @_;
440
441   my $format             =   $params{dateformat}   || $::myconfig{dateformat}   || 'yyyy-mm-dd';
442   my $num_separator      =  ($params{numberformat} || $::myconfig{numberformat} || '1,000.00') =~ m{,\d+$} ? ',' : '.';
443   $format                =~ s/yy(?:yy)?/\%Y/;
444   $format                =~ s/mm/\%m/;
445   $format                =~ s/dd/\%d/;
446
447   my $precision          =  $params{precision} || 'day';
448   $precision             =~ s/s$//;
449   my %precision_spec_map = (
450     millisecond => '%H:%M:%S' . $num_separator . '%3N',
451     second      => '%H:%M:%S',
452     minute      => '%H:%M',
453     hour        => '%H',
454   );
455
456   $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
457
458   return $datetime->strftime($format);
459 }
460
461 sub reformat_date {
462   $main::lxdebug->enter_sub(2);
463
464   my ($self, $myconfig, $date, $output_format, $longformat) = @_;
465
466   $main::lxdebug->leave_sub(2) and return "" unless ($date);
467
468   my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
469
470   $output_format =~ /(d+)/;
471   substr($output_format, $-[0], $+[0] - $-[0]) =
472     sprintf("%0" . (length($1)) . "d", $dd);
473
474   $output_format =~ /(m+)/;
475   substr($output_format, $-[0], $+[0] - $-[0]) =
476     sprintf("%0" . (length($1)) . "d", $mm);
477
478   $output_format =~ /y+/;
479   substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
480
481   $main::lxdebug->leave_sub(2);
482
483   return $output_format;
484 }
485
486 sub format_date {
487   $main::lxdebug->enter_sub();
488
489   my $self     = shift;
490   my $myconfig = shift;
491   my $yy       = shift;
492   my $mm       = shift;
493   my $dd       = shift;
494   my $yy_len   = shift || 4;
495
496   ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
497
498   $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
499
500   $yy = $yy % 100 if 2 == $yy_len;
501
502   my $format = ref $myconfig eq '' ? "$myconfig" : $myconfig->{dateformat};
503   $format =~ s{ (d+) }{ sprintf("%0" . (length($1)) . "d", $dd) }gex;
504   $format =~ s{ (m+) }{ sprintf("%0" . (length($1)) . "d", $mm) }gex;
505   $format =~ s{ (y+) }{ sprintf("%0${yy_len}d",            $yy) }gex;
506
507   $main::lxdebug->leave_sub();
508
509   return $format;
510 }
511
512 sub quote_special_chars {
513   my $self   = shift;
514   my $format = lc shift;
515   my $string = shift;
516
517   if ($self->{special_chars_map} && $self->{special_chars_map}->{$format} && $self->{special_chars_map}->{$format}->{order}) {
518     my $scmap = $self->{special_chars_map}->{$format};
519
520     map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
521   }
522
523   return $string;
524 }
525
526 sub unquote_special_chars {
527   my $self    = shift;
528   my $format  = shift;
529
530   return $self->quote_special_chars("${format}-reverse", shift);
531 }
532
533 sub remap_special_chars {
534   my $self       = shift;
535   my $src_format = shift;
536   my $dst_format = shift;
537
538   return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
539 }
540
541 sub raw_io_active {
542   my $self = shift;
543
544   return !!$self->{raw_io_active};
545 }
546
547 sub with_raw_io {
548   my $self = shift;
549   my $fh   = shift;
550   my $code = shift;
551
552   $self->{raw_io_active} = 1;
553   binmode $fh, ":raw";
554   $code->();
555   binmode $fh, ":utf8";
556   $self->{raw_io_active} = 0;
557 }
558
559 sub set_numberformat_wo_thousands_separator {
560   my $self     = shift;
561   my $myconfig = shift || \%::myconfig;
562
563   $self->{saved_numberformat} = $myconfig->{numberformat};
564   $myconfig->{numberformat}   =~ s/^1[,\.]/1/;
565 }
566
567 sub restore_numberformat {
568   my $self     = shift;
569   my $myconfig = shift || \%::myconfig;
570
571   $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
572 }
573
574 sub get_local_time_zone {
575   my $self = shift;
576   $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
577   return $self->{local_time_zone};
578 }
579
580 sub language_join {
581   my ($self, $items, %params) = @_;
582
583   $items               ||= [];
584   $params{conjunction} ||= $::locale->text('and');
585   my $num                = scalar @{ $items };
586
587   return 0 == $num ? ''
588        : 1 == $num ? $items->[0]
589        :             join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
590 }
591
592 1;
593
594 __END__
595
596 =pod
597
598 =encoding utf8
599
600 =head1 NAME
601
602 Locale - Functions for dealing with locale-dependent information
603
604 =head1 SYNOPSIS
605
606   use Locale;
607   use DateTime;
608
609   my $locale = Locale->new('de');
610   my $now    = DateTime->now_local;
611   print "Current date and time: ", $::locale->format_date_object($now, precision => 'second'), "\n";
612
613 =head1 OVERVIEW
614
615 TODO: write overview
616
617 =head1 FUNCTIONS
618
619 =over 4
620
621 =item C<date>
622
623 TODO: Describe date
624
625 =item C<findsub>
626
627 TODO: Describe findsub
628
629 =item C<format_date>
630
631 TODO: Describe format_date
632
633 =item C<format_date_object $datetime, %params>
634
635 Formats the C<$datetime> object according to the user's locale setting.
636
637 The parameter C<precision> can control whether or not the time
638 component is formatted as well:
639
640 =over 4
641
642 =item * C<day>
643
644 Only format the year, month and day. This is also the default.
645
646 =item * C<hour>
647
648 Add the hour to the date.
649
650 =item * C<minute>
651
652 Add hour:minute to the date.
653
654 =item * C<second>
655
656 Add hour:minute:second to the date.
657
658 =item * C<millisecond>
659
660 Add hour:minute:second.millisecond to the date. The decimal separator
661 is derived from the number format.
662
663 =item * C<numberformat>
664
665 The number format to use, e.g. C<1,000.00>. If unset the user's
666 current number format is used.
667
668 =item * C<dateformat>
669
670 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
671 date format is used.
672
673 =back
674
675 =item C<get_local_time_zone>
676
677 TODO: Describe get_local_time_zone
678
679 =item C<lang_to_locale>
680
681 TODO: Describe lang_to_locale
682
683 =item C<new>
684
685 TODO: Describe new
686
687 =item C<parse_date>
688
689 TODO: Describe parse_date
690
691 =item C<parse_date_to_object $string, %params>
692
693 Parses a date and optional timestamp in C<$string> and returns an
694 instance of L<DateTime>. The date and number formats used are the ones
695 the user has currently selected. They can be overriden by passing them
696 in as parameters to this function, though.
697
698 The time stamps can have up to millisecond precision.
699
700 =item C<quote_special_chars>
701
702 TODO: Describe quote_special_chars
703
704 =item C<raw_io_active>
705
706 TODO: Describe raw_io_active
707
708 =item C<reformat_date>
709
710 TODO: Describe reformat_date
711
712 =item C<remap_special_chars>
713
714 TODO: Describe remap_special_chars
715
716 =item C<restore_numberformat>
717
718 TODO: Describe restore_numberformat
719
720 =item C<set_numberformat_wo_thousands_separator>
721
722 TODO: Describe set_numberformat_wo_thousands_separator
723
724 =item C<text>
725
726 TODO: Describe text
727
728 =item C<unquote_special_chars>
729
730 TODO: Describe unquote_special_chars
731
732 =item C<with_raw_io>
733
734 TODO: Describe with_raw_io
735
736 =back
737
738 =head1 BUGS
739
740 Nothing here yet.
741
742 =head1 AUTHOR
743
744 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
745
746 =cut