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