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