Loc3.05: -langorder, exists

[perl/loc/.git] / Lirama / Loc3.pm

diff --git a/Lirama/Loc3.pm b/Lirama/Loc3.pm
index d7f4d49b6be6dbcb260d367631744c94713c2d46..781208a9ab2ccfec6509ddd6a79094af28eac99f 100644 (file)
--- a/Lirama/Loc3.pm
+++ b/Lirama/Loc3.pm
@@ -3,7 +3,7 @@ package Lirama::Loc3;
 use strict;
 use warnings;
 
-our $VERSION = '3.01';
+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,54 +20,69 @@ sub TIEHASH {
 }
 
 sub FETCH {
-       my $this = shift;
-       local $_ = shift;
+       my ($this, $id) = @_;
        # get setting (denoted by leading dash)
-       return wantarray ? @{$this->{$_}} : $this->{$_}->[0]
-               if $_ eq "-langpref";
-       return $this->{$_}
-               if $_ eq "-path" or $_ eq "-seperator";
+       return $this->{$id} if $id =~ /^-/;
        # array ref used for passing arguments
-       ($_, @_) = @$_ if ref $_ eq "ARRAY";
-       # add default path unless specified
-       $_ = $this->{-path} . $this->{-seperator} . $_
-               if defined $this->{-seperator} and not /\Q$this->{-seperator}/;
+       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
-       if (exists $this->{$_}) {
-               $_ = $this->loc($this->{$_});
+       if (exists $this->{$id}) {
+               $id = $this->loc($this->{$id});
                # adaptive string (code)
-               $_ = $_->(@_) if ref $_ eq "CODE";
+               $id = $id->(@args) if ref $id eq "CODE";
        } else {
-               #todo: else remove path
-               s/.*\Q$this->{-seperator}//s if defined $this->{-seperator};
+               # 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]} }
 
@@ -85,15 +100,15 @@ Lirama::Loc3 - Localize strings
        use Lirama::Loc3;
 
        tie my %loc, "Lirama::Loc3", {
-               -langs => {en => 100, eo => 95},
+               -langs => {eo => 100, en => 95},
                -seperator => '_',
-               _test => {
-                       en => "this is a test",
+               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