Indirekte Objektnotation fixen
[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     local *IN;
84     if (open(IN, "<", "locale/$country/all")) {
85       my $code = join("", <IN>);
86       eval($code);
87       close(IN);
88     }
89   }
90
91   binmode STDOUT, ":utf8";
92   binmode STDERR, ":utf8";
93
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');
100
101   $self->_read_special_chars_file($country);
102
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));
109 }
110
111 sub _handle_markup {
112   my $self    = shift;
113   my $str     = shift;
114
115   my $escaped = 0;
116   my $new_str = '';
117
118   for (my $i = 0; $i < length $str; $i++) {
119     my $char = substr $str, $i, 1;
120
121     if ($escaped) {
122       if ($char eq 'n') {
123         $new_str .= "\n";
124
125       } elsif ($char eq 'r') {
126         $new_str .= "\r";
127
128       } elsif ($char eq 's') {
129         $new_str .= ' ';
130
131       } elsif ($char eq 'x') {
132         $new_str .= chr(hex(substr($str, $i + 1, 2)));
133         $i       += 2;
134
135       } else {
136         $new_str .= $char;
137       }
138
139       $escaped  = 0;
140
141     } elsif ($char eq '\\') {
142       $escaped  = 1;
143
144     } else {
145       $new_str .= $char;
146     }
147   }
148
149   return $new_str;
150 }
151
152 sub _read_special_chars_file {
153   my $self    = shift;
154   my $country = shift;
155
156   if (! -f "locale/$country/special_chars") {
157     $self->{special_chars_map} = {};
158     return;
159   }
160
161   $self->{special_chars_map} = Inifile->new("locale/$country/special_chars", 'verbatim' => 1);
162
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'));
165
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;
170     }
171
172     my $scmap = $self->{special_chars_map}->{$format};
173     my $order = $self->{iconv}->convert($scmap->{order});
174     delete $scmap->{order};
175
176     foreach my $key (keys %{ $scmap }) {
177       $scmap->{$key} = $self->_handle_markup($self->{iconv}->convert($scmap->{$key}));
178
179       my $new_key    = $self->_handle_markup($self->{iconv}->convert($key));
180
181       if ($key ne $new_key) {
182         $scmap->{$new_key} = $scmap->{$key};
183         delete $scmap->{$key};
184       }
185     }
186
187     $self->{special_chars_map}->{"${format}-reverse"}          = { reverse %{ $scmap } };
188
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} } ];
191   }
192 }
193
194 sub text {
195   my $self = shift;
196   my $text = shift;
197
198   return $text->translated if (ref($text) || '') eq 'SL::Locale::String';
199
200   if ($self->{texts}->{$text}) {
201     $text = $self->{iconv}->convert($self->{texts}->{$text});
202   } else {
203     $text = $self->{iconv_english}->convert($text);
204   }
205
206   if (@_) {
207     $text = Form->format_string($text, @_);
208   }
209
210   return $text;
211 }
212
213 sub lang_to_locale {
214   my ($self, $requested_lang) = @_;
215
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';
221
222   return $requested_locale;
223 }
224
225 sub findsub {
226   $main::lxdebug->enter_sub();
227
228   my ($self, $text) = @_;
229   my $text_rev      = lc $self->{iconv_reverse}->convert($text);
230   $text_rev         =~ s/[\s\-]+/_/g;
231
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;
238
239       $translation =  lc $translation;
240       $translation =~ s/[\s\-]+/_/g;
241
242       $self->{texts_reverse}->{$translation} ||= [ ];
243       push @{ $self->{texts_reverse}->{$translation} }, $original;
244     }
245   }
246
247   my $sub_name;
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}" };
250
251   $main::form->error("$text not defined in locale/$self->{countrycode}/all") if !$sub_name;
252
253   $main::lxdebug->leave_sub();
254
255   return $sub_name;
256 }
257
258 sub date {
259   $main::lxdebug->enter_sub();
260
261   my ($self, $myconfig, $date, $longformat) = @_;
262
263   if (!$date) {
264     $main::lxdebug->leave_sub();
265     return '';
266   }
267
268   my $longdate  = "";
269   my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
270
271   my ($spc, $yy, $mm, $dd);
272
273     # get separator
274   $spc = $myconfig->{dateformat};
275   $spc =~ s/\w//g;
276   $spc = substr($spc, 1, 1);
277
278   if ($date =~ /\D/) {
279     if ($myconfig->{dateformat} =~ /^yy/) {
280       ($yy, $mm, $dd) = split /\D/, $date;
281     }
282     if ($myconfig->{dateformat} =~ /^mm/) {
283       ($mm, $dd, $yy) = split /\D/, $date;
284     }
285     if ($myconfig->{dateformat} =~ /^dd/) {
286       ($dd, $mm, $yy) = split /\D/, $date;
287     }
288   } else {
289     $date = substr($date, 2);
290     ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
291   }
292
293   $dd *= 1;
294   $mm--;
295   $yy = ($yy < 70) ? $yy + 2000 : $yy;
296   $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
297
298   if ($myconfig->{dateformat} =~ /^dd/) {
299     if (defined $longformat && $longformat == 0) {
300       $mm++;
301       $dd = "0$dd" if ($dd < 10);
302       $mm = "0$mm" if ($mm < 10);
303       $longdate = "$dd$spc$mm$spc$yy";
304     } else {
305       $longdate = "$dd";
306       $longdate .= ($spc eq '.') ? ". " : " ";
307       $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
308     }
309   } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") {
310
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) {
314       $mm++;
315       $dd = "0$dd" if ($dd < 10);
316       $mm = "0$mm" if ($mm < 10);
317       $longdate = "$yy-$mm-$dd";
318     } else {
319       $longdate = "$dd. ";
320       $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
321     }
322   } else {
323     if (defined $longformat && $longformat == 0) {
324       $mm++;
325       $dd = "0$dd" if ($dd < 10);
326       $mm = "0$mm" if ($mm < 10);
327       $longdate = "$mm$spc$dd$spc$yy";
328     } else {
329       $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy";
330     }
331   }
332
333   $main::lxdebug->leave_sub();
334
335   return $longdate;
336 }
337
338 sub parse_date {
339   $main::lxdebug->enter_sub(2);
340
341   my ($self, $myconfig, $date, $longformat) = @_;
342   my ($spc, $yy, $mm, $dd);
343
344   unless ($date) {
345     $main::lxdebug->leave_sub(2);
346     return ();
347   }
348
349   # get separator
350   $spc = $myconfig->{dateformat};
351   $spc =~ s/\w//g;
352   $spc = substr($spc, 1, 1);
353
354   if ($date =~ /\D/) {
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;
361     }
362   } else {
363     $date = substr($date, 2);
364     ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
365   }
366
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;
371
372   $main::lxdebug->leave_sub(2);
373   return ($yy, $mm, $dd);
374 }
375
376 sub parse_date_to_object {
377   my ($self, $string, %params) = @_;
378
379   return undef if !defined $string;
380
381   $params{dateformat}        ||= $::myconfig{dateformat}   || 'yy-mm-dd';
382   $params{numberformat}      ||= $::myconfig{numberformat} || '1,000.00';
383   my $num_separator            = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
384
385   my ($date_str, $time_str)    = split m{\s+}, $string, 2;
386   my ($yy, $mm, $dd)           = $self->parse_date(\%params, $date_str);
387
388   my ($hour, $minute, $second) = split m/:/, ($time_str || '');
389   $second ||= '0';
390
391   ($second, my $millisecond)   = split quotemeta($num_separator), $second, 2;
392   $_ ||= 0 for ($hour, $minute, $millisecond);
393
394   $millisecond                 = substr $millisecond, 0, 3;
395   $millisecond                .= '0' x (3 - length $millisecond);
396
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);
399 }
400
401 sub format_date_object_to_time {
402   my ($self, $datetime, %params) = @_;
403
404   my $format =  $::myconfig{timeformat} || 'hh:mm';
405   $format    =~ s/hh/\%H/;
406   $format    =~ s/mm/\%M/;
407   $format    =~ s/ss/\%S/;
408
409   return $datetime->strftime($format);
410 }
411
412 sub format_date_object {
413   my ($self, $datetime, %params)    = @_;
414
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/;
420
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',
426     minute      => '%H:%M',
427     hour        => '%H',
428   );
429
430   $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
431
432   return $datetime->strftime($format);
433 }
434
435 sub reformat_date {
436   $main::lxdebug->enter_sub(2);
437
438   my ($self, $myconfig, $date, $output_format, $longformat) = @_;
439
440   $main::lxdebug->leave_sub(2) and return "" unless ($date);
441
442   my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
443
444   $output_format =~ /d+/;
445   substr($output_format, $-[0], $+[0] - $-[0]) =
446     sprintf("%0" . (length($&)) . "d", $dd);
447
448   $output_format =~ /m+/;
449   substr($output_format, $-[0], $+[0] - $-[0]) =
450     sprintf("%0" . (length($&)) . "d", $mm);
451
452   $output_format =~ /y+/;
453   substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
454
455   $main::lxdebug->leave_sub(2);
456
457   return $output_format;
458 }
459
460 sub format_date {
461   $main::lxdebug->enter_sub();
462
463   my $self     = shift;
464   my $myconfig = shift;
465   my $yy       = shift;
466   my $mm       = shift;
467   my $dd       = shift;
468   my $yy_len   = shift || 4;
469
470   ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
471
472   $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
473
474   $yy = $yy % 100 if 2 == $yy_len;
475
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;
480
481   $main::lxdebug->leave_sub();
482
483   return $format;
484 }
485
486 sub quote_special_chars {
487   my $self   = shift;
488   my $format = lc shift;
489   my $string = shift;
490
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};
493
494     map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
495   }
496
497   return $string;
498 }
499
500 sub unquote_special_chars {
501   my $self    = shift;
502   my $format  = shift;
503
504   return $self->quote_special_chars("${format}-reverse", shift);
505 }
506
507 sub remap_special_chars {
508   my $self       = shift;
509   my $src_format = shift;
510   my $dst_format = shift;
511
512   return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
513 }
514
515 sub raw_io_active {
516   my $self = shift;
517
518   return !!$self->{raw_io_active};
519 }
520
521 sub with_raw_io {
522   my $self = shift;
523   my $fh   = shift;
524   my $code = shift;
525
526   $self->{raw_io_active} = 1;
527   binmode $fh, ":raw";
528   $code->();
529   binmode $fh, ":utf8";
530   $self->{raw_io_active} = 0;
531 }
532
533 sub set_numberformat_wo_thousands_separator {
534   my $self     = shift;
535   my $myconfig = shift || \%::myconfig;
536
537   $self->{saved_numberformat} = $myconfig->{numberformat};
538   $myconfig->{numberformat}   =~ s/^1[,\.]/1/;
539 }
540
541 sub restore_numberformat {
542   my $self     = shift;
543   my $myconfig = shift || \%::myconfig;
544
545   $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
546 }
547
548 sub get_local_time_zone {
549   my $self = shift;
550   $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
551   return $self->{local_time_zone};
552 }
553
554 sub language_join {
555   my ($self, $items, %params) = @_;
556
557   $items               ||= [];
558   $params{conjunction} ||= $::locale->text('and');
559   my $num                = scalar @{ $items };
560
561   return 0 == $num ? ''
562        : 1 == $num ? $items->[0]
563        :             join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
564 }
565
566 1;
567
568 __END__
569
570 =pod
571
572 =encoding utf8
573
574 =head1 NAME
575
576 Locale - Functions for dealing with locale-dependent information
577
578 =head1 SYNOPSIS
579
580   use Locale;
581   use DateTime;
582
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";
586
587 =head1 OVERVIEW
588
589 TODO: write overview
590
591 =head1 FUNCTIONS
592
593 =over 4
594
595 =item C<date>
596
597 TODO: Describe date
598
599 =item C<findsub>
600
601 TODO: Describe findsub
602
603 =item C<format_date>
604
605 TODO: Describe format_date
606
607 =item C<format_date_object $datetime, %params>
608
609 Formats the C<$datetime> object accoring to the user's locale setting.
610
611 The parameter C<precision> can control whether or not the time
612 component is formatted as well:
613
614 =over 4
615
616 =item * C<day>
617
618 Only format the year, month and day. This is also the default.
619
620 =item * C<hour>
621
622 Add the hour to the date.
623
624 =item * C<minute>
625
626 Add hour:minute to the date.
627
628 =item * C<second>
629
630 Add hour:minute:second to the date.
631
632 =item * C<millisecond>
633
634 Add hour:minute:second.millisecond to the date. The decimal separator
635 is derived from the number format.
636
637 =item * C<numberformat>
638
639 The number format to use, e.g. C<1,000.00>. If unset the user's
640 current number format is used.
641
642 =item * C<dateformat>
643
644 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
645 date format is used.
646
647 =back
648
649 =item C<get_local_time_zone>
650
651 TODO: Describe get_local_time_zone
652
653 =item C<lang_to_locale>
654
655 TODO: Describe lang_to_locale
656
657 =item C<new>
658
659 TODO: Describe new
660
661 =item C<parse_date>
662
663 TODO: Describe parse_date
664
665 =item C<parse_date_to_object $string, %params>
666
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.
671
672 The time stamps can have up to millisecond precision.
673
674 =item C<quote_special_chars>
675
676 TODO: Describe quote_special_chars
677
678 =item C<raw_io_active>
679
680 TODO: Describe raw_io_active
681
682 =item C<reformat_date>
683
684 TODO: Describe reformat_date
685
686 =item C<remap_special_chars>
687
688 TODO: Describe remap_special_chars
689
690 =item C<restore_numberformat>
691
692 TODO: Describe restore_numberformat
693
694 =item C<set_numberformat_wo_thousands_separator>
695
696 TODO: Describe set_numberformat_wo_thousands_separator
697
698 =item C<text>
699
700 TODO: Describe text
701
702 =item C<unquote_special_chars>
703
704 TODO: Describe unquote_special_chars
705
706 =item C<with_raw_io>
707
708 TODO: Describe with_raw_io
709
710 =back
711
712 =head1 BUGS
713
714 Nothing here yet.
715
716 =head1 AUTHOR
717
718 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
719
720 =cut