Lyrical::Loc

diff --git a/Lyrical/Loc.pm b/Lyrical/Loc.pm
new file mode 100644 (file)
index 0000000..8dfaeb2
--- /dev/null
+++ b/Lyrical/Loc.pm
@@ -0,0 +1,102 @@
+package Lyrical::Loc;
+
+use strict;
+use warnings;
+use utf8;
+
+require Exporter;
+our @ISA       = qw(Exporter);
+our @EXPORT    = qw(langpref);
+our @EXPORT_OK = qw(@langpref loc);
+
+our @langpref = qw(en eo nl sv de fr ru kr);
+
+sub langpref {
+       # @_ is order of languages (prefered language last)
+       for my $lang (@_) {
+               unshift @langpref, splice @langpref, $_, 1  # move to front
+                       for grep $langpref[$_] eq $lang, 0..$#langpref;
+       } # find $lang and move to front of @langpref
+} # langpref
+
+sub loc($) {
+       my $this = shift;
+       # localize to most preferred language
+       ref $_[0] eq "HASH" or return $_[0];
+       defined $_[0]{$_} and return $_[0]{$_} for @langpref;
+} # loc
+
+sub TIEHASH {
+       my $this = shift;
+
+       my $node = {};
+       while (my ($id, $langs) = each %{$_[0]}) {
+               $node->{$id} = $this->loc($langs);
+       } # add each element of i18n hash
+
+       return bless $node, $this;
+} # new
+
+sub FETCH {
+       my $this = shift;
+       # custom expand: get preferred language from given hash
+       return $this->loc($_[0]) if ref $_[0] eq "HASH";  # deprecated in favor of loc()
+       # array ref used for passing arguments
+       @_ = @{$_[0]} if ref $_[0] eq "ARRAY";
+       # get localized string by identifier
+       local $_ = shift;
+               #todo: shouldn't occur - find out where this is done, then fix and remove this check
+               defined $_ or return '';
+       $_ = $this->{$_} if exists $this->{$_};
+       # static output if no arguments given
+       return $_ unless @_;  # unnecessary but faster for common case
+       # adaptive string (code)
+       $_ = $_->(@_) if ref $_ eq "CODE";
+       # dynamic output
+       return sprintf $_, @_;
+} # FETCH
+
+sub EXISTS {
+       # true if identifier is localized; non-existing strings still return
+       # themselves, so in standard meaning everything would exist
+       return exists $_[0]->{$_[1]};
+} # EXISTS
+
+sub FIRSTKEY {
+       my $this = shift;
+       keys %$this;  # reset iterator
+       return each %$this;
+} # FIRSTKEY
+
+sub NEXTKEY {
+       my $this = shift;
+       return each %$this;
+} # NEXTKEY
+
+1;
+
+=head1 NAME
+
+Lyrical::Loc - Localize strings
+
+=head1 SYNOPSIS
+
+       use Lyrical::Loc;
+       langpref(qw/en eo/);
+       tie my %loc, "Lyrical::Loc", {
+               test => {
+                       en => "this is a test",
+                       eo => "cxi tio estas testo",
+                       nl => "dit is een test",
+               },
+       };
+
+       print $loc{test};
+
+=head1 DESCRIPTION
+
+=head1 AUTHOR
+
+Mischa Poslawsky <shiar@shiar.org>
+
+=cut