lib/Onis/Language.pm

   1 package Onis::Language;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Exporter;
   7
   8 use Onis::Config (qw(get_config));
   9
  10 =head1 NAME
  11
  12 Onis::Language - Translate strings to a user-defined language.
  13
  14 =cut
  15
  16 @Onis::Language::EXPORT_OK = qw/translate/;
  17 @Onis::Language::ISA = ('Exporter');
  18
  19 our %Translations = ();
  20
  21 my $VERSION = '$Id$';
  22 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
  23
  24 read_language_file ();
  25
  26 return (1);
  27
  28 =head1 CONFIGURATION OPTIONS
  29
  30 =over 4
  31
  32 =item B<language_file>: I<german.lang>;
  33
  34 Tries to open and read the language-definitions from this file. If it fails
  35 (file does not exist, is not readable, uses an unknown syntax and the like) the
  36 default-language, english, will be used.
  37
  38 =back
  39
  40 =cut
  41
  42 sub read_language_file
  43 {
  44         my $line;
  45         my $fh;
  46         my $file = get_config ('language_file');
  47
  48         if (!$file)
  49         {
  50                 return (1);
  51         }
  52
  53         unless (open ($fh, "< $file"))
  54         {
  55                 print STDERR $/, __FILE__, ": Unable to open language file ``$file''. Will use default-language english.", $/;
  56                 return (0);
  57         }
  58
  59         while ($line = <$fh>)
  60         {
  61                 my @strings = ();
  62
  63                 chomp ($line);
  64
  65                 if ($line =~ m/^((?:"(?:[^\\"]|\\.)*"|[^#])*)#/)
  66                 {
  67                         $line = $1;
  68                 }
  69
  70                 while ($line =~ m/"((?:[^\\"]|\\.)+)"/g)
  71                 {
  72                         push (@strings, $1);
  73                 }
  74
  75                 if (scalar (@strings) < 2)
  76                 {
  77                         next;
  78                 }
  79
  80                 my $key = shift (@strings);
  81                 $Translations{$key} = \@strings;
  82         }
  83
  84         close ($fh);
  85         return (1);
  86 }
  87
  88 =head1 EXPORTED FUNCTIONS
  89
  90 =over 4
  91
  92 =item B<translate> (I<$string>)
  93
  94 Translates the given string using the language file loaded. If no translation
  95 is found returns the original string.
  96
  97 =cut
  98
  99 sub translate
 100 {
 101         my $string = shift;
 102         my $retval;
 103
 104         if (defined ($Translations{$string}))
 105         {
 106                 my $array = $Translations{$string};
 107
 108                 if (scalar (@$array) == 1)
 109                 {
 110                         $retval = $array->[0];
 111                 }
 112                 else
 113                 {
 114                         my $num = scalar (@$array);
 115                         my $pick = int (rand ($num));
 116
 117                         $retval = $array->[$pick];
 118                 }
 119         }
 120         else
 121         {
 122                 if ($::DEBUG & 0x10)
 123                 {
 124                         $retval = '<span style="color: red; background-color: yellow;">'
 125                         .       $string . '</span>';
 126                 }
 127                 else
 128                 {
 129                         $retval = $string;
 130                 }
 131         }
 132
 133         return ($retval);
 134 }
 135
 136 =back
 137
 138 =head1 AUTHOR
 139
 140 Florian octo Forster E<lt>octo at verplant.orgE<gt>
 141
 142 =cut