Lyrical/Loc.pm

   1 package Lyrical::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 de fr ru kr);
  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 =head1 NAME
  79
  80 Lyrical::Loc - Localize strings
  81
  82 =head1 SYNOPSIS
  83
  84         use Lyrical::Loc;
  85         langpref(qw/en eo/);
  86         tie my %loc, "Lyrical::Loc", {
  87                 test => {
  88                         en => "this is a test",
  89                         eo => "cxi tio estas testo",
  90                         nl => "dit is een test",
  91                 },
  92         };
  93
  94         print $loc{test};
  95
  96 =head1 DESCRIPTION
  97
  98 =head1 AUTHOR
  99
 100 Mischa Poslawsky <shiar@shiar.org>
 101
 102 =cut