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