Lirama/Loc3.pm

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