1 #====================================================================
 
   4 # Based on SQL-Ledger Version 2.1.9
 
   5 # Web http://www.lx-office.org
 
   7 #=====================================================================
 
   8 # SQL-Ledger Accounting
 
   9 # Copyright (C) 1998-2002
 
  11 #  Author: Dieter Simader
 
  12 #   Email: dsimader@sql-ledger.org
 
  13 #     Web: http://www.sql-ledger.org
 
  15 # Contributors: Thomas Bayen <bayen@gmx.de>
 
  16 #               Antti Kaihola <akaihola@siba.fi>
 
  17 #               Moritz Bunkus (tex code)
 
  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.
 
  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 #======================================================================
 
  33 # Translations and number/date formatting
 
  35 #======================================================================
 
  41 use List::Util qw(first);
 
  42 use List::MoreUtils qw(any);
 
  51 my %locales_by_country;
 
  54   $main::lxdebug->enter_sub();
 
  56   my ($type, $country) = @_;
 
  58   $country ||= $::lx_office_conf{system}->{language};
 
  62   if (!$locales_by_country{$country}) {
 
  66     $self->_init($country);
 
  68     $locales_by_country{$country} = $self;
 
  71   $main::lxdebug->leave_sub();
 
  73   return $locales_by_country{$country}
 
  80   $self->{countrycode} = $country;
 
  82   if ($country && -d "locale/$country") {
 
  84     if (open(IN, "<", "locale/$country/all")) {
 
  85       my $code = join("", <IN>);
 
  91   binmode STDOUT, ":utf8";
 
  92   binmode STDERR, ":utf8";
 
  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');
 
 101   $self->_read_special_chars_file($country);
 
 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));
 
 118   for (my $i = 0; $i < length $str; $i++) {
 
 119     my $char = substr $str, $i, 1;
 
 125       } elsif ($char eq 'r') {
 
 128       } elsif ($char eq 's') {
 
 131       } elsif ($char eq 'x') {
 
 132         $new_str .= chr(hex(substr($str, $i + 1, 2)));
 
 141     } elsif ($char eq '\\') {
 
 152 sub _read_special_chars_file {
 
 156   if (! -f "locale/$country/special_chars") {
 
 157     $self->{special_chars_map} = {};
 
 161   $self->{special_chars_map} = Inifile->new("locale/$country/special_chars", 'verbatim' => 1);
 
 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'));
 
 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;
 
 172     my $scmap = $self->{special_chars_map}->{$format};
 
 173     my $order = $self->{iconv}->convert($scmap->{order});
 
 174     delete $scmap->{order};
 
 176     foreach my $key (keys %{ $scmap }) {
 
 177       $scmap->{$key} = $self->_handle_markup($self->{iconv}->convert($scmap->{$key}));
 
 179       my $new_key    = $self->_handle_markup($self->{iconv}->convert($key));
 
 181       if ($key ne $new_key) {
 
 182         $scmap->{$new_key} = $scmap->{$key};
 
 183         delete $scmap->{$key};
 
 187     $self->{special_chars_map}->{"${format}-reverse"}          = { reverse %{ $scmap } };
 
 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} } ];
 
 198   return $text->translated if (ref($text) || '') eq 'SL::Locale::String';
 
 200   if ($self->{texts}->{$text}) {
 
 201     $text = $self->{iconv}->convert($self->{texts}->{$text});
 
 203     $text = $self->{iconv_english}->convert($text);
 
 207     $text = Form->format_string($text, @_);
 
 214   my ($self, $requested_lang) = @_;
 
 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';
 
 222   return $requested_locale;
 
 226   $main::lxdebug->enter_sub();
 
 228   my ($self, $text) = @_;
 
 229   my $text_rev      = lc $self->{iconv_reverse}->convert($text);
 
 230   $text_rev         =~ s/[\s\-]+/_/g;
 
 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;
 
 239       $translation =  lc $translation;
 
 240       $translation =~ s/[\s\-]+/_/g;
 
 242       $self->{texts_reverse}->{$translation} ||= [ ];
 
 243       push @{ $self->{texts_reverse}->{$translation} }, $original;
 
 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}" };
 
 251   $main::form->error("$text not defined in locale/$self->{countrycode}/all") if !$sub_name;
 
 253   $main::lxdebug->leave_sub();
 
 259   $main::lxdebug->enter_sub();
 
 261   my ($self, $myconfig, $date, $longformat) = @_;
 
 264     $main::lxdebug->leave_sub();
 
 269   my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
 
 271   my ($spc, $yy, $mm, $dd);
 
 274   $spc = $myconfig->{dateformat};
 
 276   $spc = substr($spc, 1, 1);
 
 279     if ($myconfig->{dateformat} =~ /^yy/) {
 
 280       ($yy, $mm, $dd) = split /\D/, $date;
 
 282     if ($myconfig->{dateformat} =~ /^mm/) {
 
 283       ($mm, $dd, $yy) = split /\D/, $date;
 
 285     if ($myconfig->{dateformat} =~ /^dd/) {
 
 286       ($dd, $mm, $yy) = split /\D/, $date;
 
 289     $date = substr($date, 2);
 
 290     ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
 
 295   $yy = ($yy < 70) ? $yy + 2000 : $yy;
 
 296   $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
 
 298   if ($myconfig->{dateformat} =~ /^dd/) {
 
 299     if (defined $longformat && $longformat == 0) {
 
 301       $dd = "0$dd" if ($dd < 10);
 
 302       $mm = "0$mm" if ($mm < 10);
 
 303       $longdate = "$dd$spc$mm$spc$yy";
 
 306       $longdate .= ($spc eq '.') ? ". " : " ";
 
 307       $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
 
 309   } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") {
 
 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) {
 
 315       $dd = "0$dd" if ($dd < 10);
 
 316       $mm = "0$mm" if ($mm < 10);
 
 317       $longdate = "$yy-$mm-$dd";
 
 320       $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
 
 323     if (defined $longformat && $longformat == 0) {
 
 325       $dd = "0$dd" if ($dd < 10);
 
 326       $mm = "0$mm" if ($mm < 10);
 
 327       $longdate = "$mm$spc$dd$spc$yy";
 
 329       $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy";
 
 333   $main::lxdebug->leave_sub();
 
 339   $main::lxdebug->enter_sub(2);
 
 341   my ($self, $myconfig, $date, $longformat) = @_;
 
 342   my ($spc, $yy, $mm, $dd);
 
 345     $main::lxdebug->leave_sub(2);
 
 350   $spc = $myconfig->{dateformat};
 
 352   $spc = substr($spc, 1, 1);
 
 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;
 
 363     $date = substr($date, 2);
 
 364     ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
 
 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;
 
 372   $main::lxdebug->leave_sub(2);
 
 373   return ($yy, $mm, $dd);
 
 376 sub parse_date_to_object {
 
 377   my ($self, $string, %params) = @_;
 
 379   return undef if !defined $string;
 
 381   $params{dateformat}        ||= $::myconfig{dateformat}   || 'yy-mm-dd';
 
 382   $params{numberformat}      ||= $::myconfig{numberformat} || '1,000.00';
 
 383   my $num_separator            = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
 
 385   my ($date_str, $time_str)    = split m{\s+}, $string, 2;
 
 386   my ($yy, $mm, $dd)           = $self->parse_date(\%params, $date_str);
 
 388   my ($hour, $minute, $second) = split m/:/, ($time_str || '');
 
 391   ($second, my $millisecond)   = split quotemeta($num_separator), $second, 2;
 
 392   $_ ||= 0 for ($hour, $minute, $millisecond);
 
 394   $millisecond                 = substr $millisecond, 0, 3;
 
 395   $millisecond                .= '0' x (3 - length $millisecond);
 
 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);
 
 401 sub format_date_object_to_time {
 
 402   my ($self, $datetime, %params) = @_;
 
 404   my $format =  $::myconfig{timeformat} || 'hh:mm';
 
 405   $format    =~ s/hh/\%H/;
 
 406   $format    =~ s/mm/\%M/;
 
 407   $format    =~ s/ss/\%S/;
 
 409   return $datetime->strftime($format);
 
 412 sub format_date_object {
 
 413   my ($self, $datetime, %params)    = @_;
 
 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/;
 
 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',
 
 430   $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
 
 432   return $datetime->strftime($format);
 
 436   $main::lxdebug->enter_sub(2);
 
 438   my ($self, $myconfig, $date, $output_format, $longformat) = @_;
 
 440   $main::lxdebug->leave_sub(2) and return "" unless ($date);
 
 442   my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
 
 444   $output_format =~ /d+/;
 
 445   substr($output_format, $-[0], $+[0] - $-[0]) =
 
 446     sprintf("%0" . (length($&)) . "d", $dd);
 
 448   $output_format =~ /m+/;
 
 449   substr($output_format, $-[0], $+[0] - $-[0]) =
 
 450     sprintf("%0" . (length($&)) . "d", $mm);
 
 452   $output_format =~ /y+/;
 
 453   substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
 
 455   $main::lxdebug->leave_sub(2);
 
 457   return $output_format;
 
 461   $main::lxdebug->enter_sub();
 
 464   my $myconfig = shift;
 
 468   my $yy_len   = shift || 4;
 
 470   ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
 
 472   $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
 
 474   $yy = $yy % 100 if 2 == $yy_len;
 
 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;
 
 481   $main::lxdebug->leave_sub();
 
 486 sub quote_special_chars {
 
 488   my $format = lc shift;
 
 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};
 
 494     map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
 
 500 sub unquote_special_chars {
 
 504   return $self->quote_special_chars("${format}-reverse", shift);
 
 507 sub remap_special_chars {
 
 509   my $src_format = shift;
 
 510   my $dst_format = shift;
 
 512   return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
 
 518   return !!$self->{raw_io_active};
 
 526   $self->{raw_io_active} = 1;
 
 529   binmode $fh, ":utf8";
 
 530   $self->{raw_io_active} = 0;
 
 533 sub set_numberformat_wo_thousands_separator {
 
 535   my $myconfig = shift || \%::myconfig;
 
 537   $self->{saved_numberformat} = $myconfig->{numberformat};
 
 538   $myconfig->{numberformat}   =~ s/^1[,\.]/1/;
 
 541 sub restore_numberformat {
 
 543   my $myconfig = shift || \%::myconfig;
 
 545   $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
 
 548 sub get_local_time_zone {
 
 550   $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
 
 551   return $self->{local_time_zone};
 
 555   my ($self, $items, %params) = @_;
 
 558   $params{conjunction} ||= $::locale->text('and');
 
 559   my $num                = scalar @{ $items };
 
 561   return 0 == $num ? ''
 
 562        : 1 == $num ? $items->[0]
 
 563        :             join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
 
 576 Locale - Functions for dealing with locale-dependent information
 
 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";
 
 601 TODO: Describe findsub
 
 605 TODO: Describe format_date
 
 607 =item C<format_date_object $datetime, %params>
 
 609 Formats the C<$datetime> object accoring to the user's locale setting.
 
 611 The parameter C<precision> can control whether or not the time
 
 612 component is formatted as well:
 
 618 Only format the year, month and day. This is also the default.
 
 622 Add the hour to the date.
 
 626 Add hour:minute to the date.
 
 630 Add hour:minute:second to the date.
 
 632 =item * C<millisecond>
 
 634 Add hour:minute:second.millisecond to the date. The decimal separator
 
 635 is derived from the number format.
 
 637 =item * C<numberformat>
 
 639 The number format to use, e.g. C<1,000.00>. If unset the user's
 
 640 current number format is used.
 
 642 =item * C<dateformat>
 
 644 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
 
 649 =item C<get_local_time_zone>
 
 651 TODO: Describe get_local_time_zone
 
 653 =item C<lang_to_locale>
 
 655 TODO: Describe lang_to_locale
 
 663 TODO: Describe parse_date
 
 665 =item C<parse_date_to_object $string, %params>
 
 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.
 
 672 The time stamps can have up to millisecond precision.
 
 674 =item C<quote_special_chars>
 
 676 TODO: Describe quote_special_chars
 
 678 =item C<raw_io_active>
 
 680 TODO: Describe raw_io_active
 
 682 =item C<reformat_date>
 
 684 TODO: Describe reformat_date
 
 686 =item C<remap_special_chars>
 
 688 TODO: Describe remap_special_chars
 
 690 =item C<restore_numberformat>
 
 692 TODO: Describe restore_numberformat
 
 694 =item C<set_numberformat_wo_thousands_separator>
 
 696 TODO: Describe set_numberformat_wo_thousands_separator
 
 702 =item C<unquote_special_chars>
 
 704 TODO: Describe unquote_special_chars
 
 708 TODO: Describe with_raw_io
 
 718 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>