X-Git-Url: http://git.shiar.nl/perl/loc/.git/blobdiff_plain/7c9dced1e223d99ca5284554a9c93edbd0f8054a..refs/heads/master:/Lirama/Loc3.pm

diff --git a/Lirama/Loc3.pm b/Lirama/Loc3.pm
index 2a89689..781208a 100644
--- a/Lirama/Loc3.pm
+++ b/Lirama/Loc3.pm
@@ -3,7 +3,7 @@ package Lirama::Loc3;
 use strict;
 use warnings;
 
-our $VERSION = '3.00';
+our $VERSION = '3.05';
 
 sub loc($) {
 	my $this = shift;
@@ -11,7 +11,7 @@ sub loc($) {
 	# if it isn't, we're done already:
 	ref $_[0] eq "HASH" or return $_[0];
 	# localize to most preferred language
-	defined $_[0]{$_} and return $_[0]{$_} for @{$this->{-langpref}};
+	defined $_[0]{$_} and return $_[0]{$_} for @{$this->{-langorder}};
 } # loc
 
 sub TIEHASH {
@@ -20,46 +20,69 @@ sub TIEHASH {
 }
 
 sub FETCH {
-	my $this = shift;
+	my ($this, $id) = @_;
 	# get setting (denoted by leading dash)
-	return wantarray ? @{$this->{$_[0]}} : $this->{$_[0]}->[0]
-		if $_[0] eq "-langpref";
-	return $this->{$_[0]}
-		if $_[0] eq "-path";
+	return $this->{$id} if $id =~ /^-/;
 	# array ref used for passing arguments
-	@_ = @{$_[0]} if ref $_[0] eq "ARRAY";
+	my @args;
+	($id, @args) = @$id if ref $id eq "ARRAY";
+	# add leading base path unless specified absolute
+	$id = $this->{-path} . $id
+		if defined $this->{-path} and not $id =~ s/^\Q$this->{-seperator}//;
 	# get localized string by identifier
-	local $_ = shift;
-	# add default path unless specified
-	$_ = $this->{-path} . '_' . $_ unless /_/;
-			#todo: shouldn't occur - find out where this is done, then fix and remove this check
-		#	defined $_ or return '';
-	$_ = $this->loc($this->{$_}) if exists $this->{$_};
-	#todo: else remove path
-	# adaptive string (code)
-	$_ = $_->(@_) if ref $_ eq "CODE";
+	if (exists $this->{$id}) {
+		$id = $this->loc($this->{$id});
+		# adaptive string (code)
+		$id = $id->(@args) if ref $id eq "CODE";
+	} else {
+		# not found: strip path and use literal identifier
+		$id =~ s/.*\Q$this->{-seperator}//s if defined $this->{-seperator};
+	}
 	# static output if no arguments given
-	return $_ unless @_;  # unnecessary but faster for common case
+	return $id unless @args;  # unnecessary but faster for common case
 	# dynamic output
-	return sprintf $_, @_;
+	return sprintf $id, @args;
 } # FETCH
 
+sub langorder($$) {
+	my $this = shift;
+	my %index = %{$this->{-langs}}; # overall index
+	defined $index{$_} and $index{$_} *= $this->{-langpref}{$_}
+		for keys %{$this->{-langpref}};
+	return [ sort {$index{$b} <=> $index{$a}} keys %index ];
+} # langorder
+
 sub STORE {
 	my ($this, $option, $val) = @_;
 	if ($option eq "-langpref") {
-		# set order of languages (prefered language first)
+		# set preference index of languages
 		$this->{$option} = $val;
+		$this->{-langorder} = $this->langorder;
 	} # -langpref
+	elsif ($option eq "-langorder") {
+		# set order of languages (prefered language first)
+		$this->{$option} = $val;
+	} # -langorder
+	elsif ($option eq "-seperator") {
+		$this->{-path} =~ s/\Q$this->{$option}/$val/g
+			if defined $this->{$option}; # replace old occurances
+		$this->{$option} = $val;
+	} # -seperator
 	else {
+		$val .= $this->{-seperator} if $option eq "-path" and $val ne '';
 		$this->{$option} = $val;
 #		$_[0]->{$_[1]} = $_[2];
 	}
 } # STORE
 
-# Same as found in Tie::StdHash
+sub EXISTS   {
+	my ($this, $id) = @_;
+	$id = $this->{-path} . $id
+		if defined $this->{-path} and not $id =~ s/^\Q$this->{-seperator}//;
+	return exists $this->{$id};
+} # EXISTS
 
 #todo: make path-aware
-sub EXISTS   { exists $_[0]->{$_[1]} }
 sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
 sub NEXTKEY  { each %{$_[0]} }
 
@@ -77,13 +100,15 @@ Lirama::Loc3 - Localize strings
 	use Lirama::Loc3;
 
 	tie my %loc, "Lirama::Loc3", {
-		_test => {
-			en => "this is a test",
+		-langs => {eo => 100, en => 95},
+		-seperator => '_',
+		test => {
 			eo => "cxi tio estas testo",
+			en => "this is a test",
 		},
 	};
 
-	$loc{-langpref} = [qw/nl en eo/];  # prefer I<nl> (dutch) texts
+	$loc{-langpref} = {nl => 100, en => 50};  # prefer I<nl> (dutch) texts
 	print $loc{test};  # "this is a test", since dutch is unavailable
 
 =head1 DESCRIPTION