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., 51 Franklin Street, Fifth Floor, Boston,
 
  32 #======================================================================
 
  34 # Translations and number/date formatting
 
  36 #======================================================================
 
  42 use List::Util qw(first);
 
  43 use List::MoreUtils qw(any);
 
  52 my %locales_by_country;
 
  55   $main::lxdebug->enter_sub();
 
  57   my ($type, $country) = @_;
 
  59   $country ||= $::lx_office_conf{system}->{language};
 
  63   if (!$locales_by_country{$country}) {
 
  67     $self->_init($country);
 
  69     $locales_by_country{$country} = $self;
 
  72   $main::lxdebug->leave_sub();
 
  74   return $locales_by_country{$country}
 
  80   return -f "locale/$country/all";
 
  87   $self->{countrycode} = $country;
 
  89   if ($country && -d "locale/$country") {
 
  90     if (open my $in, "<", "locale/$country/all") {
 
  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;
 
 102       for my $file (@files) {
 
 103         if (open my $in, "<", "locale/$country/more/$file") {
 
 108           $self->{texts}{$_} = $self->{more_texts}{$_} for keys %{ $self->{more_texts} };
 
 114   binmode STDOUT, ":utf8";
 
 115   binmode STDERR, ":utf8";
 
 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');
 
 124   $self->_read_special_chars_file($country);
 
 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));
 
 141   for (my $i = 0; $i < length $str; $i++) {
 
 142     my $char = substr $str, $i, 1;
 
 148       } elsif ($char eq 'r') {
 
 151       } elsif ($char eq 's') {
 
 154       } elsif ($char eq 'x') {
 
 155         $new_str .= chr(hex(substr($str, $i + 1, 2)));
 
 164     } elsif ($char eq '\\') {
 
 175 sub _read_special_chars_file {
 
 179   if (! -f "locale/$country/special_chars") {
 
 180     $self->{special_chars_map} = {};
 
 184   $self->{special_chars_map} = Inifile->new("locale/$country/special_chars", 'verbatim' => 1);
 
 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'));
 
 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;
 
 195     my $scmap = $self->{special_chars_map}->{$format};
 
 196     my $order = $self->{iconv}->convert($scmap->{order});
 
 197     delete $scmap->{order};
 
 199     foreach my $key (keys %{ $scmap }) {
 
 200       $scmap->{$key} = $self->_handle_markup($self->{iconv}->convert($scmap->{$key}));
 
 202       my $new_key    = $self->_handle_markup($self->{iconv}->convert($key));
 
 204       if ($key ne $new_key) {
 
 205         $scmap->{$new_key} = $scmap->{$key};
 
 206         delete $scmap->{$key};
 
 210     $self->{special_chars_map}->{"${format}-reverse"}          = { reverse %{ $scmap } };
 
 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} } ];
 
 221   return $text->translated if (ref($text) || '') eq 'SL::Locale::String';
 
 223   if ($self->{texts}->{$text}) {
 
 224     $text = $self->{iconv}->convert($self->{texts}->{$text});
 
 226     $text = $self->{iconv_english}->convert($text);
 
 230     $text = Form->format_string($text, @_);
 
 237   my ($self, $requested_lang) = @_;
 
 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';
 
 245   return $requested_locale;
 
 249   $main::lxdebug->enter_sub();
 
 251   my ($self, $text) = @_;
 
 252   my $text_rev      = lc $self->{iconv_reverse}->convert($text);
 
 253   $text_rev         =~ s/[\s\-]+/_/g;
 
 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;
 
 262       $translation =  lc $translation;
 
 263       $translation =~ s/[\s\-]+/_/g;
 
 265       $self->{texts_reverse}->{$translation} ||= [ ];
 
 266       push @{ $self->{texts_reverse}->{$translation} }, $original;
 
 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}" };
 
 274   $main::form->error("$text not defined in locale/$self->{countrycode}/all") if !$sub_name;
 
 276   $main::lxdebug->leave_sub();
 
 282   $main::lxdebug->enter_sub();
 
 284   my ($self, $myconfig, $date, $longformat) = @_;
 
 287     $main::lxdebug->leave_sub();
 
 292   my $longmonth = ($longformat) ? 'LONG_MONTH' : 'SHORT_MONTH';
 
 294   my ($spc, $yy, $mm, $dd);
 
 297   $spc = $myconfig->{dateformat};
 
 299   $spc = substr($spc, 1, 1);
 
 302     if ($myconfig->{dateformat} =~ /^yy/) {
 
 303       ($yy, $mm, $dd) = split /\D/, $date;
 
 305     if ($myconfig->{dateformat} =~ /^mm/) {
 
 306       ($mm, $dd, $yy) = split /\D/, $date;
 
 308     if ($myconfig->{dateformat} =~ /^dd/) {
 
 309       ($dd, $mm, $yy) = split /\D/, $date;
 
 312     $date = substr($date, 2);
 
 313     ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
 
 318   $yy = ($yy < 70) ? $yy + 2000 : $yy;
 
 319   $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
 
 321   if ($myconfig->{dateformat} =~ /^dd/) {
 
 322     if (defined $longformat && $longformat == 0) {
 
 324       $dd = "0$dd" if ($dd < 10);
 
 325       $mm = "0$mm" if ($mm < 10);
 
 326       $longdate = "$dd$spc$mm$spc$yy";
 
 329       $longdate .= ($spc eq '.') ? ". " : " ";
 
 330       $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
 
 332   } elsif ($myconfig->{dateformat} eq "yyyy-mm-dd") {
 
 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) {
 
 338       $dd = "0$dd" if ($dd < 10);
 
 339       $mm = "0$mm" if ($mm < 10);
 
 340       $longdate = "$yy-$mm-$dd";
 
 343       $longdate .= &text($self, $self->{$longmonth}[$mm]) . " $yy";
 
 346     if (defined $longformat && $longformat == 0) {
 
 348       $dd = "0$dd" if ($dd < 10);
 
 349       $mm = "0$mm" if ($mm < 10);
 
 350       $longdate = "$mm$spc$dd$spc$yy";
 
 352       $longdate = &text($self, $self->{$longmonth}[$mm]) . " $dd, $yy";
 
 356   $main::lxdebug->leave_sub();
 
 362   $main::lxdebug->enter_sub(2);
 
 364   my ($self, $myconfig, $date, $longformat) = @_;
 
 365   my ($spc, $yy, $mm, $dd);
 
 368     $main::lxdebug->leave_sub(2);
 
 373   $spc = $myconfig->{dateformat};
 
 375   $spc = substr($spc, 1, 1);
 
 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;
 
 386     $date = substr($date, 2);
 
 387     ($yy, $mm, $dd) = ($date =~ /(..)(..)(..)/);
 
 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;
 
 395   $main::lxdebug->leave_sub(2);
 
 396   return ($yy, $mm, $dd);
 
 399 sub parse_date_to_object {
 
 400   my ($self, $string, %params) = @_;
 
 402   return undef if !defined $string;
 
 404   return DateTime->today_local                      if lc($string) eq 'today';
 
 405   return DateTime->today_local->subtract(days => 1) if lc($string) eq 'yesterday';
 
 407   $params{dateformat}        ||= $::myconfig{dateformat}   || 'yy-mm-dd';
 
 408   $params{numberformat}      ||= $::myconfig{numberformat} || '1,000.00';
 
 409   my $num_separator            = $params{numberformat} =~ m{,\d+$} ? ',' : '.';
 
 411   my ($date_str, $time_str)    = split m{\s+}, $string, 2;
 
 412   my ($yy, $mm, $dd)           = $self->parse_date(\%params, $date_str);
 
 414   my ($hour, $minute, $second) = split m/:/, ($time_str || '');
 
 417   ($second, my $millisecond)   = split quotemeta($num_separator), $second, 2;
 
 418   $_ ||= 0 for ($hour, $minute, $millisecond);
 
 420   $millisecond                 = substr $millisecond, 0, 3;
 
 421   $millisecond                .= '0' x (3 - length $millisecond);
 
 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);
 
 427 sub format_date_object_to_time {
 
 428   my ($self, $datetime, %params) = @_;
 
 430   my $format =  $::myconfig{timeformat} || 'hh:mm';
 
 431   $format    =~ s/hh/\%H/;
 
 432   $format    =~ s/mm/\%M/;
 
 433   $format    =~ s/ss/\%S/;
 
 435   return $datetime->strftime($format);
 
 438 sub format_date_object {
 
 439   my ($self, $datetime, %params)    = @_;
 
 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/;
 
 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',
 
 456   $format .= ' ' . $precision_spec_map{$precision} if $precision_spec_map{$precision};
 
 458   return $datetime->strftime($format);
 
 462   $main::lxdebug->enter_sub(2);
 
 464   my ($self, $myconfig, $date, $output_format, $longformat) = @_;
 
 466   $main::lxdebug->leave_sub(2) and return "" unless ($date);
 
 468   my ($yy, $mm, $dd) = $self->parse_date($myconfig, $date);
 
 470   $output_format =~ /(d+)/;
 
 471   substr($output_format, $-[0], $+[0] - $-[0]) =
 
 472     sprintf("%0" . (length($1)) . "d", $dd);
 
 474   $output_format =~ /(m+)/;
 
 475   substr($output_format, $-[0], $+[0] - $-[0]) =
 
 476     sprintf("%0" . (length($1)) . "d", $mm);
 
 478   $output_format =~ /y+/;
 
 479   substr($output_format, $-[0], $+[0] - $-[0]) = $yy;
 
 481   $main::lxdebug->leave_sub(2);
 
 483   return $output_format;
 
 487   $main::lxdebug->enter_sub();
 
 490   my $myconfig = shift;
 
 494   my $yy_len   = shift || 4;
 
 496   ($yy, $mm, $dd) = ($yy->year, $yy->month, $yy->day) if ref $yy eq 'DateTime';
 
 498   $main::lxdebug->leave_sub() and return "" unless $yy && $mm && $dd;
 
 500   $yy = $yy % 100 if 2 == $yy_len;
 
 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;
 
 507   $main::lxdebug->leave_sub();
 
 512 sub quote_special_chars {
 
 514   my $format = lc shift;
 
 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};
 
 520     map { $string =~ s/\Q${_}\E/$scmap->{$_}/g } @{ $scmap->{order} };
 
 526 sub unquote_special_chars {
 
 530   return $self->quote_special_chars("${format}-reverse", shift);
 
 533 sub remap_special_chars {
 
 535   my $src_format = shift;
 
 536   my $dst_format = shift;
 
 538   return $self->quote_special_chars($dst_format, $self->quote_special_chars("${src_format}-reverse", shift));
 
 544   return !!$self->{raw_io_active};
 
 552   $self->{raw_io_active} = 1;
 
 555   binmode $fh, ":utf8";
 
 556   $self->{raw_io_active} = 0;
 
 559 sub set_numberformat_wo_thousands_separator {
 
 561   my $myconfig = shift || \%::myconfig;
 
 563   $self->{saved_numberformat} = $myconfig->{numberformat};
 
 564   $myconfig->{numberformat}   =~ s/^1[,\.]/1/;
 
 567 sub restore_numberformat {
 
 569   my $myconfig = shift || \%::myconfig;
 
 571   $myconfig->{numberformat} = $self->{saved_numberformat} if $self->{saved_numberformat};
 
 574 sub get_local_time_zone {
 
 576   $self->{local_time_zone} ||= DateTime::TimeZone->new(name => 'local');
 
 577   return $self->{local_time_zone};
 
 581   my ($self, $items, %params) = @_;
 
 584   $params{conjunction} ||= $::locale->text('and');
 
 585   my $num                = scalar @{ $items };
 
 587   return 0 == $num ? ''
 
 588        : 1 == $num ? $items->[0]
 
 589        :             join(', ', @{ $items }[0..$num - 2]) . ' ' . $params{conjunction} . ' ' . $items->[$num - 1];
 
 602 Locale - Functions for dealing with locale-dependent information
 
 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";
 
 627 TODO: Describe findsub
 
 631 TODO: Describe format_date
 
 633 =item C<format_date_object $datetime, %params>
 
 635 Formats the C<$datetime> object according to the user's locale setting.
 
 637 The parameter C<precision> can control whether or not the time
 
 638 component is formatted as well:
 
 644 Only format the year, month and day. This is also the default.
 
 648 Add the hour to the date.
 
 652 Add hour:minute to the date.
 
 656 Add hour:minute:second to the date.
 
 658 =item * C<millisecond>
 
 660 Add hour:minute:second.millisecond to the date. The decimal separator
 
 661 is derived from the number format.
 
 663 =item * C<numberformat>
 
 665 The number format to use, e.g. C<1,000.00>. If unset the user's
 
 666 current number format is used.
 
 668 =item * C<dateformat>
 
 670 The date format to use, e.g. C<mm/dd/yy>. If unset the user's current
 
 675 =item C<get_local_time_zone>
 
 677 TODO: Describe get_local_time_zone
 
 679 =item C<lang_to_locale>
 
 681 TODO: Describe lang_to_locale
 
 689 TODO: Describe parse_date
 
 691 =item C<parse_date_to_object $string, %params>
 
 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.
 
 698 The time stamps can have up to millisecond precision.
 
 700 =item C<quote_special_chars>
 
 702 TODO: Describe quote_special_chars
 
 704 =item C<raw_io_active>
 
 706 TODO: Describe raw_io_active
 
 708 =item C<reformat_date>
 
 710 TODO: Describe reformat_date
 
 712 =item C<remap_special_chars>
 
 714 TODO: Describe remap_special_chars
 
 716 =item C<restore_numberformat>
 
 718 TODO: Describe restore_numberformat
 
 720 =item C<set_numberformat_wo_thousands_separator>
 
 722 TODO: Describe set_numberformat_wo_thousands_separator
 
 728 =item C<unquote_special_chars>
 
 730 TODO: Describe unquote_special_chars
 
 734 TODO: Describe with_raw_io
 
 744 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>