Lirama/Loc3.pm

   1 package Lirama::Loc3;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '3.05';
   7
   8 sub loc($) {
   9         my $this = shift;
  10         # get one value from a hash of multiple options
  11         # if it isn't, we're done already:
  12         ref $_[0] eq "HASH" or return $_[0];
  13         # localize to most preferred language
  14         defined $_[0]{$_} and return $_[0]{$_} for @{$this->{-langorder}};
  15 } # loc
  16
  17 sub TIEHASH {
  18         #todo: set -path
  19         return bless $_[1], $_[0];  # bless the l10n hash
  20 }
  21
  22 sub FETCH {
  23         my ($this, $id) = @_;
  24         # get setting (denoted by leading dash)
  25         return $this->{$id} if $id =~ /^-/;
  26         # array ref used for passing arguments
  27         my @args;
  28         ($id, @args) = @$id if ref $id eq "ARRAY";
  29         # add leading base path unless specified absolute
  30         $id = $this->{-path} . $id
  31                 if defined $this->{-path} and not $id =~ s/^\Q$this->{-seperator}//;
  32         # get localized string by identifier
  33         if (exists $this->{$id}) {
  34                 $id = $this->loc($this->{$id});
  35                 # adaptive string (code)
  36                 $id = $id->(@args) if ref $id eq "CODE";
  37         } else {
  38                 # not found: strip path and use literal identifier
  39                 $id =~ s/.*\Q$this->{-seperator}//s if defined $this->{-seperator};
  40         }
  41         # static output if no arguments given
  42         return $id unless @args;  # unnecessary but faster for common case
  43         # dynamic output
  44         return sprintf $id, @args;
  45 } # FETCH
  46
  47 sub langorder($$) {
  48         my $this = shift;
  49         my %index = %{$this->{-langs}}; # overall index
  50         defined $index{$_} and $index{$_} *= $this->{-langpref}{$_}
  51                 for keys %{$this->{-langpref}};
  52         return [ sort {$index{$b} <=> $index{$a}} keys %index ];
  53 } # langorder
  54
  55 sub STORE {
  56         my ($this, $option, $val) = @_;
  57         if ($option eq "-langpref") {
  58                 # set preference index of languages
  59                 $this->{$option} = $val;
  60                 $this->{-langorder} = $this->langorder;
  61         } # -langpref
  62         elsif ($option eq "-langorder") {
  63                 # set order of languages (prefered language first)
  64                 $this->{$option} = $val;
  65         } # -langorder
  66         elsif ($option eq "-seperator") {
  67                 $this->{-path} =~ s/\Q$this->{$option}/$val/g
  68                         if defined $this->{$option}; # replace old occurances
  69                 $this->{$option} = $val;
  70         } # -seperator
  71         else {
  72                 $val .= $this->{-seperator} if $option eq "-path" and $val ne '';
  73                 $this->{$option} = $val;
  74 #               $_[0]->{$_[1]} = $_[2];
  75         }
  76 } # STORE
  77
  78 sub EXISTS   {
  79         my ($this, $id) = @_;
  80         $id = $this->{-path} . $id
  81                 if defined $this->{-path} and not $id =~ s/^\Q$this->{-seperator}//;
  82         return exists $this->{$id};
  83 } # EXISTS
  84
  85 #todo: make path-aware
  86 sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
  87 sub NEXTKEY  { each %{$_[0]} }
  88
  89 1;
  90
  91 __END__
  92
  93
  94 =head1 NAME
  95
  96 Lirama::Loc3 - Localize strings
  97
  98 =head1 SYNOPSIS
  99
 100         use Lirama::Loc3;
 101
 102         tie my %loc, "Lirama::Loc3", {
 103                 -langs => {eo => 100, en => 95},
 104                 -seperator => '_',
 105                 test => {
 106                         eo => "cxi tio estas testo",
 107                         en => "this is a test",
 108                 },
 109         };
 110
 111         $loc{-langpref} = {nl => 100, en => 50};  # prefer I<nl> (dutch) texts
 112         print $loc{test};  # "this is a test", since dutch is unavailable
 113
 114 =head1 DESCRIPTION
 115
 116 Returns a text in the most preferred language available.
 117 Mainly intended for translation of different strings on a website.
 118
 119 =over 4
 120
 121 =item C<langpref>
 122
 123 Shared so we only have to set one var to change all translations;
 124 may yet be a very bad idea (does it work correctly in modperl?)
 125
 126 =item C<tie>
 127
 128 =item C<loc>
 129
 130 =item C<exists>
 131
 132 True if identifier is localized;
 133 even though non-existing strings still return themselves.
 134
 135 =back
 136
 137 =head1 SEE ALSO
 138
 139 L<Lirama::Loc3::Auto|Lirama::Loc3::Auto>
 140
 141 L<Locale::Maketext|Locale::Maketext>
 142
 143 =head1 AUTHOR
 144
 145 Mischa POSLAWSKY <shiar@shiar.org>
 146
 147 Copyright 2005 Mischa POSLAWSKY. All rights reserved.
 148
 149 =cut