DBConnect Caching: rollback nur bei Handles ohne AutoCommit
[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   $params{dateformat}        ||= $::myconfig{dateformat}   || 'yy-mm-dd';
398   $params{numberformat}      ||= $::myconfig{numberformat} || '1,000.00';
399   my $num_separator            = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
400
401   my ($date_str, $time_str)    = split m{\s+}, $string, 2;
402   my ($yy, $mm, $dd)           = $self->parse_date(\%params, $date_str);
403
404   my ($hour, $minute, $second) = split m/:/, ($time_str || '');
405   $second ||= '0';
406
407   ($second, my $millisecond)   = split quotemeta($num_separator), $second, 2;
408   $_ ||= 0 for ($hour, $minute, $millisecond);
409
410   $millisecond                 = substr $millisecond, 0, 3;
411   $millisecond                .= '0' x (3 - length $millisecond);
412
413   return undef unless $yy && $mm && $dd;
414   return DateTime->new(year => $yy, month => $mm, day => $dd, hour => $hour * 1, minute => $minute * 1, second => $second * 1, nanosecond => $millisecond * 1000000);
415 }
416
417 sub format_date_object_to_time {
418   my ($self, $datetime, %params) = @_;
419
420   my $format =  $::myconfig{timeformat} || 'hh:mm';
421   $format    =~ s/hh/\%H/;
422   $format    =~ s/mm/\%M/;
423   $format    =~ s/ss/\%S/;
424
425   return $datetime->strftime($format);
426 }
427
428 sub format_date_object {
429   my ($self, $datetime, %params)    = @_;
430
431   my $format             =   $params{dateformat}   || $::myconfig{dateformat}   || 'yyyy-mm-dd';
432   my $num_separator      =  ($params{numberformat} || $::myconfig{numberformat} || '1,000.00') =~ m{,\d+$} ? ',' : '.';
433   $format                =~ s/yy(?:yy)?/\%Y/;
434   $format                =~ s/mm/\%m/;
435   $format                =~ s/dd/\%d/;
436
437   my $precision          =  $params{precision} || 'day';
438   $precision             =~ s/s$//;
439   my %precision_spec_map = (
440     millisecond => '%H:%M:%S' . $num_separator . '%3N',
441     second      => '%H:%M:%S',
442     minute      => '%H:%M',
443     hour        => '%H',
444   );
445
446   $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
447
448   return $datetime->strftime($format);
449 }
450
451 sub reformat_date {
452   $main::lxdebug->enter_sub(2);
453
454   my ($self, $myconfig, $date, $output_format, $longformat) = @_;
455
456   $main::lxdebug->leave_sub(2) and return "" unless ($date);
457
458   my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
459
460   $output_format =~ /(d+)/;
461   substr($output_format, $-[0], $+[0] - $-[0]) =
462     sprintf("%0" . (length($1)) . "d", $dd);
463
464   $output_format =~ /(m+)/;
465   substr($output_format, $-[0], $+[0] - $-[0]) =
466     sprintf("%0" . (length($1)) . "d", $mm);
467
468   $output_format =~ /y+/;
469   substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
470
471   $main::lxdebug->leave_sub(2);
472
473   return $output_format;
474 }
475
476 sub format_date {
477   $main::lxdebug->enter_sub();
478
479   my $self     = shift;
480   my $myconfig = shift;
481   my $yy       = shift;
482   my $mm       = shift;
483   my $dd       = shift;
484   my $yy_len   = shift || 4;
485
486   ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
487
488   $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
489
490   $yy = $yy % 100 if 2 == $yy_len;
491
492   my $format = ref $myconfig eq '' ? "$myconfig" : $myconfig->{dateformat};
493   $format =~ s{ (d+) }{ sprintf("%0" . (length($1)) . "d", $dd) }gex;
494   $format =~ s{ (m+) }{ sprintf("%0" . (length($1)) . "d", $mm) }gex;
495   $format =~ s{ (y+) }{ sprintf("%0${yy_len}d",            $yy) }gex;
496
497   $main::lxdebug->leave_sub();
498
499   return $format;
500 }
501
502 sub quote_special_chars {
503   my $self   = shift;
504   my $format = lc shift;
505   my $string = shift;
506
507   if ($self->{special_chars_map} && $self->{special_chars_map}->{$format} && $self->{special_chars_map}->{$format}->{order}) {
508     my $scmap = $self->{special_chars_map}->{$format};
509
510     map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
511   }
512
513   return $string;
514 }
515
516 sub unquote_special_chars {
517   my $self    = shift;
518   my $format  = shift;
519
520   return $self->quote_special_chars("${format}-reverse", shift);
521 }
522
523 sub remap_special_chars {
524   my $self       = shift;
525   my $src_format = shift;
526   my $dst_format = shift;
527
528   return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
529 }
530
531 sub raw_io_active {
532   my $self = shift;
533
534   return !!$self->{raw_io_active};
535 }
536
537 sub with_raw_io {
538   my $self = shift;
539   my $fh   = shift;
540   my $code = shift;
541
542   $self->{raw_io_active} = 1;
543   binmode $fh, ":raw";
544   $code->();
545   binmode $fh, ":utf8";
546   $self->{raw_io_active} = 0;
547 }
548
549 sub set_numberformat_wo_thousands_separator {
550   my $self     = shift;
551   my $myconfig = shift || \%::myconfig;
552
553   $self->{saved_numberformat} = $myconfig->{numberformat};
554   $myconfig->{numberformat}   =~ s/^1[,\.]/1/;
555 }
556
557 sub restore_numberformat {
558   my $self     = shift;
559   my $myconfig = shift || \%::myconfig;
560
561   $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
562 }
563
564 sub get_local_time_zone {
565   my $self = shift;
566   $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
567   return $self->{local_time_zone};
568 }
569
570 sub language_join {
571   my ($self, $items, %params) = @_;
572
573   $items               ||= [];
574   $params{conjunction} ||= $::locale->text('and');
575   my $num                = scalar @{ $items };
576
577   return 0 == $num ? ''
578        : 1 == $num ? $items->[0]
579        :             join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
580 }
581
582 1;
583
584 __END__
585
586 =pod
587
588 =encoding utf8
589
590 =head1 NAME
591
592 Locale - Functions for dealing with locale-dependent information
593
594 =head1 SYNOPSIS
595
596   use Locale;
597   use DateTime;
598
599   my $locale = Locale->new('de');
600   my $now    = DateTime->now_local;
601   print "Current date and time: ", $::locale->format_date_object($now, precision => 'second'), "\n";
602
603 =head1 OVERVIEW
604
605 TODO: write overview
606
607 =head1 FUNCTIONS
608
609 =over 4
610
611 =item C<date>
612
613 TODO: Describe date
614
615 =item C<findsub>
616
617 TODO: Describe findsub
618
619 =item C<format_date>
620
621 TODO: Describe format_date
622
623 =item C<format_date_object $datetime, %params>
624
625 Formats the C<$datetime> object accoring to the user's locale setting.
626
627 The parameter C<precision> can control whether or not the time
628 component is formatted as well:
629
630 =over 4
631
632 =item * C<day>
633
634 Only format the year, month and day. This is also the default.
635
636 =item * C<hour>
637
638 Add the hour to the date.
639
640 =item * C<minute>
641
642 Add hour:minute to the date.
643
644 =item * C<second>
645
646 Add hour:minute:second to the date.
647
648 =item * C<millisecond>
649
650 Add hour:minute:second.millisecond to the date. The decimal separator
651 is derived from the number format.
652
653 =item * C<numberformat>
654
655 The number format to use, e.g. C<1,000.00>. If unset the user's
656 current number format is used.
657
658 =item * C<dateformat>
659
660 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
661 date format is used.
662
663 =back
664
665 =item C<get_local_time_zone>
666
667 TODO: Describe get_local_time_zone
668
669 =item C<lang_to_locale>
670
671 TODO: Describe lang_to_locale
672
673 =item C<new>
674
675 TODO: Describe new
676
677 =item C<parse_date>
678
679 TODO: Describe parse_date
680
681 =item C<parse_date_to_object $string, %params>
682
683 Parses a date and optional timestamp in C<$string> and returns an
684 instance of L<DateTime>. The date and number formats used are the ones
685 the user has currently selected. They can be overriden by passing them
686 in as parameters to this function, though.
687
688 The time stamps can have up to millisecond precision.
689
690 =item C<quote_special_chars>
691
692 TODO: Describe quote_special_chars
693
694 =item C<raw_io_active>
695
696 TODO: Describe raw_io_active
697
698 =item C<reformat_date>
699
700 TODO: Describe reformat_date
701
702 =item C<remap_special_chars>
703
704 TODO: Describe remap_special_chars
705
706 =item C<restore_numberformat>
707
708 TODO: Describe restore_numberformat
709
710 =item C<set_numberformat_wo_thousands_separator>
711
712 TODO: Describe set_numberformat_wo_thousands_separator
713
714 =item C<text>
715
716 TODO: Describe text
717
718 =item C<unquote_special_chars>
719
720 TODO: Describe unquote_special_chars
721
722 =item C<with_raw_io>
723
724 TODO: Describe with_raw_io
725
726 =back
727
728 =head1 BUGS
729
730 Nothing here yet.
731
732 =head1 AUTHOR
733
734 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
735
736 =cut