From ba7e261cdfb61d46af7ec8314f19f5700422a14e Mon Sep 17 00:00:00 2001
From: Mischa POSLAWSKY <perl@shiar.org>
Date: Tue, 1 Mar 2005 17:38:39 +0000
Subject: [PATCH] Lyrical::Loc

---
 Lyrical/Loc.pm | 102 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 102 insertions(+)
 create mode 100644 Lyrical/Loc.pm

diff --git a/Lyrical/Loc.pm b/Lyrical/Loc.pm
new file mode 100644
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
-- 
2.30.0