use strict;
use warnings;
-our $VERSION = '3.01';
+our $VERSION = '3.05';
sub loc($) {
my $this = shift;
# 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 {
}
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]} }
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