Lirama/Loc2.pm

   1 package Lirama::Loc2;
   2
   3 use strict;
   4 use warnings;
   5 use utf8; #todo: does it even matter?
   6
   7 our $VERSION = '2.00';
   8
   9 require Exporter;
  10 our @ISA       = qw(Exporter);
  11 our @EXPORT    = qw(langpref);
  12 our @EXPORT_OK = qw(loc);
  13
  14 our @langpref;# = qw(en eo nl sv el hu de fr ru kr);
  15
  16 sub langpref {
  17         @langpref = @_ if @_;  # set order of languages (prefered language first)
  18         return wantarray ? @langpref : $langpref[0];
  19 }
  20
  21 sub loc($) {
  22         my $this = shift;
  23         # get one value from a hash of multiple options
  24         # if it isn't, we're done already:
  25         ref $_[0] eq "HASH" or return $_[0];
  26         # localize to most preferred language
  27         defined $_[0]{$_} and return $_[0]{$_} for @langpref;
  28 }
  29
  30 sub TIEHASH {
  31         return bless $_[1], $_[0];  # bless the l10n hash
  32 }
  33
  34 sub FETCH {
  35         my $this = shift;
  36                         # custom expand: get preferred language from given hash
  37                 #       return $this->loc($_[0]) if ref $_[0] eq "HASH";  # deprecated in favor of loc()
  38         # array ref used for passing arguments
  39         @_ = @{$_[0]} if ref $_[0] eq "ARRAY";
  40         # get localized string by identifier
  41         local $_ = shift;
  42                         #todo: shouldn't occur - find out where this is done, then fix and remove this check
  43                 #       defined $_ or return '';
  44         $_ = $this->loc($this->{$_}) if exists $this->{$_};
  45 #       $_ = ref $this->{$_} eq "HASH" ? $this->loc($this->{$_}) : $this->{$_} if exists $this->{$_};
  46         # static output if no arguments given
  47         return $_ unless @_;  # unnecessary but faster for common case
  48         # adaptive string (code)
  49         $_ = $_->(@_) if ref $_ eq "CODE";
  50         # dynamic output
  51         return sprintf $_, @_;
  52 }
  53
  54 # Same as found in Tie::StdHash
  55
  56 sub EXISTS   { exists $_[0]->{$_[1]} }
  57 sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
  58 sub NEXTKEY  { each %{$_[0]} }
  59
  60 1;
  61
  62 __END__
  63
  64
  65 =head1 NAME
  66
  67 Lirama::Loc - Localize strings
  68
  69 =head1 SYNOPSIS
  70
  71         use Lirama::Loc;
  72
  73         langpref(qw/nl en eo/);  # prefer I<nl> (dutch) texts
  74
  75         tie my %loc, "Lirama::Loc", {
  76                 test => {
  77                         en => "this is a test",
  78                         eo => "cxi tio estas testo",
  79                 },
  80         };
  81
  82         print $loc{test};  # "this is a test", since dutch is unavailable
  83
  84 =head1 DESCRIPTION
  85
  86 Returns a text in the most preferred language available.
  87 Mainly intended for translation of different strings on a website.
  88
  89 =over 4
  90
  91 =item C<langpref>
  92
  93 Shared so we only have to set one var to change all translations;
  94 may yet be a very bad idea (does it work correctly in modperl?)
  95
  96 =item C<tie>
  97
  98 =item C<loc>
  99
 100 =item C<exists>
 101
 102 True if identifier is localized; non-existing strings still return
 103 themselves, so in standard meaning everything would exist.
 104
 105 =back
 106
 107 =head1 SEE ALSO
 108
 109 L<Lirama::Loc::Auto|Lirama::Loc::Auto>
 110
 111 L<Locale::Maketext|Locale::Maketext>
 112
 113 =head1 AUTHOR
 114
 115 Mischa POSLAWSKY <shiar@shiar.org>
 116
 117 Copyright 2005 Mischa POSLAWSKY. All rights reserved.
 118
 119 =cut