Lirama/Loc.pm

   1 package Lirama::Loc;
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6
   7 require Exporter;
   8 our @ISA       = qw(Exporter);
   9 our @EXPORT    = qw(langpref);
  10 our @EXPORT_OK = qw(@langpref loc);
  11
  12 our @langpref = qw(en eo nl sv el hu de fr ru kr fi);
  13
  14 sub langpref {
  15         # @_ is order of languages (prefered language last)
  16         for my $lang (@_) {
  17                 unshift @langpref, splice @langpref, $_, 1  # move to front
  18                         for grep $langpref[$_] eq $lang, 0..$#langpref;
  19         } # find $lang and move to front of @langpref
  20 } # langpref
  21
  22 sub loc($) {
  23         my $this = shift;
  24         # localize to most preferred language
  25         ref $_[0] eq "HASH" or return $_[0];
  26         defined $_[0]{$_} and return $_[0]{$_} for @langpref;
  27 } # loc
  28
  29 sub TIEHASH {
  30         my $this = shift;
  31
  32         my $node = {};
  33         while (my ($id, $langs) = each %{$_[0]}) {
  34                 $node->{$id} = $this->loc($langs);
  35         } # add each element of i18n hash
  36
  37         return bless $node, $this;
  38 } # new
  39
  40 sub FETCH {
  41         my $this = shift;
  42         # custom expand: get preferred language from given hash
  43         return $this->loc($_[0]) if ref $_[0] eq "HASH";  # deprecated in favor of loc()
  44         # array ref used for passing arguments
  45         @_ = @{$_[0]} if ref $_[0] eq "ARRAY";
  46         # get localized string by identifier
  47         local $_ = shift;
  48                 #todo: shouldn't occur - find out where this is done, then fix and remove this check
  49                 defined $_ or return '';
  50         $_ = $this->{$_} if exists $this->{$_};
  51         # static output if no arguments given
  52         return $_ unless @_;  # unnecessary but faster for common case
  53         # adaptive string (code)
  54         $_ = $_->(@_) if ref $_ eq "CODE";
  55         # dynamic output
  56         return sprintf $_, @_;
  57 } # FETCH
  58
  59 sub EXISTS {
  60         # true if identifier is localized; non-existing strings still return
  61         # themselves, so in standard meaning everything would exist
  62         return exists $_[0]->{$_[1]};
  63 } # EXISTS
  64
  65 sub FIRSTKEY {
  66         my $this = shift;
  67         keys %$this;  # reset iterator
  68         return each %$this;
  69 } # FIRSTKEY
  70
  71 sub NEXTKEY {
  72         my $this = shift;
  73         return each %$this;
  74 } # NEXTKEY
  75
  76 1;
  77
  78 __END__
  79
  80
  81 =head1 NAME
  82
  83 Lirama::Loc - Localize strings
  84
  85 =head1 SYNOPSIS
  86
  87         use Lirama::Loc;
  88
  89         langpref(qw/en eo/);  # prefer esperanto texts
  90
  91         tie my %loc, "Lirama::Loc", {
  92                 test => {
  93                         en => "this is a test",
  94                         eo => "cxi tio estas testo",
  95                         nl => "dit is een test",
  96                 },
  97         };
  98
  99         print $loc{test};
 100
 101 =head1 DESCRIPTION
 102
 103 Returns a text in the preferred language.
 104
 105 =head1 SEE ALSO
 106
 107 L<Locale::Maketext|Locale::Maketext>
 108
 109 =head1 AUTHOR
 110
 111 Mischa POSLAWSKY <shiar@shiar.org>
 112
 113 Copyright 2005 Mischa POSLAWSKY. All rights reserved.
 114
 115 =cut