git.shiar.nl
/
perl
/
loc
/
.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
edbf7cf
)
Loc3.05: -langorder, exists
master
author
Mischa POSLAWSKY
<perl@shiar.org>
Wed, 31 May 2006 22:12:12 +0000
(22:12 +0000)
committer
Mischa POSLAWSKY
<perl@shiar.org>
Wed, 10 Jun 2009 17:39:58 +0000
(17:39 +0000)
Lirama/Loc3.pm
patch
|
blob
|
history
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;
use strict;
use warnings;
-our $VERSION = '3.0
1
';
+our $VERSION = '3.0
5
';
sub loc($) {
my $this = shift;
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
# 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->{-lang
pref
}};
+ defined $_[0]{$_} and return $_[0]{$_} for @{$this->{-lang
order
}};
} # loc
sub TIEHASH {
} # loc
sub TIEHASH {
@@
-20,54
+20,69
@@
sub TIEHASH {
}
sub FETCH {
}
sub FETCH {
- my $this = shift;
- local $_ = shift;
+ my ($this, $id) = @_;
# get setting (denoted by leading dash)
# 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
# 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
# get localized string by identifier
- if (exists $this->{$
_
}) {
- $
_ = $this->loc($this->{$_
});
+ if (exists $this->{$
id
}) {
+ $
id = $this->loc($this->{$id
});
# adaptive string (code)
# adaptive string (code)
- $
_ = $_->(@_) if ref $_
eq "CODE";
+ $
id = $id->(@args) if ref $id
eq "CODE";
} else {
} 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
}
# 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
# dynamic output
- return sprintf $
_, @_
;
+ return sprintf $
id, @args
;
} # FETCH
} # 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") {
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->{$option} = $val;
+ $this->{-langorder} = $this->langorder;
} # -langpref
} # -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 {
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
$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
#todo: make path-aware
-sub EXISTS { exists $_[0]->{$_[1]} }
sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
sub NEXTKEY { each %{$_[0]} }
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", {
use Lirama::Loc3;
tie my %loc, "Lirama::Loc3", {
- -langs => {e
n => 100, eo
=> 95},
+ -langs => {e
o => 100, en
=> 95},
-seperator => '_',
-seperator => '_',
- _test => {
- en => "this is a test",
+ test => {
eo => "cxi tio estas testo",
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
print $loc{test}; # "this is a test", since dutch is unavailable
=head1 DESCRIPTION