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
