In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8d4088782934a96fb4c8a4688f9c24f45ea353fa?hp=a519c2cf8a56d92061e00b715b65a73dd66692c6>
- Log ----------------------------------------------------------------- commit 8d4088782934a96fb4c8a4688f9c24f45ea353fa Author: David Golden <[email protected]> Date: Tue Jul 6 01:38:12 2010 -0400 Clean up new Locale-Maketest test for use in core M dist/Locale-Maketext/t/04_use_external_lex_cache.t commit ace47d680c1383b41a705467fadb2c64e7f39c71 Author: Todd Rinaldo <[email protected]> Date: Tue Jul 6 01:28:00 2010 -0400 Locale::Maketext external cache support This patch with tests provides RO support for lexicon hashes in Locale::Maketext. This allows you to have GDBM language files owned by root which can be accessed by non-root, but not altered. If your lexicon is a tied hash the simple act of caching the compiled value can be fatal. For example a GDBM_File GDBM_READER tied hash will die with something like: gdbm store returned -1, errno 2, key "..." at ... All you need to do is turn on caching outside of the lexicon hash itself like so: sub init { my ($lh) = @_; ... $lh->{'use_external_lex_cache'} = 1; ... } And then instead of storing the compiled value in the lexicon hash it will store it in $lh->{'_external_lex_cache'} I've verified that blead is the authoritative location for Locale::Maketext source. Signed-off-by: David Golden <[email protected]> M MANIFEST M dist/Locale-Maketext/lib/Locale/Maketext.pm M dist/Locale-Maketext/lib/Locale/Maketext.pod A dist/Locale-Maketext/t/04_use_external_lex_cache.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + dist/Locale-Maketext/lib/Locale/Maketext.pm | 57 +++++++++++++------- dist/Locale-Maketext/lib/Locale/Maketext.pod | 19 +++++++ dist/Locale-Maketext/t/04_use_external_lex_cache.t | 38 +++++++++++++ 4 files changed, 95 insertions(+), 20 deletions(-) create mode 100644 dist/Locale-Maketext/t/04_use_external_lex_cache.t diff --git a/MANIFEST b/MANIFEST index b97e7de..a600a0a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2730,6 +2730,7 @@ dist/Locale-Maketext/lib/Locale/Maketext.pod Locale::Maketext documentation dist/Locale-Maketext/lib/Locale/Maketext/TPJ13.pod Locale::Maketext documentation article dist/Locale-Maketext/README Locale::Maketext dist/Locale-Maketext/t/01_about_verbose.t See if Locale::Maketext works +dist/Locale-Maketext/t/04_use_external_lex_cache.t See if Locale::Maketext works dist/Locale-Maketext/t/10_make.t See if Locale::Maketext works dist/Locale-Maketext/t/20_get.t See if Locale::Maketext works dist/Locale-Maketext/t/30_local.t See if Locale::Maketext works diff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pm b/dist/Locale-Maketext/lib/Locale/Maketext.pm index 1bfbbc9..7a10ffb 100644 --- a/dist/Locale-Maketext/lib/Locale/Maketext.pm +++ b/dist/Locale-Maketext/lib/Locale/Maketext.pm @@ -10,7 +10,7 @@ use I18N::LangTags 0.30 (); BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } } # define the constant 'DEBUG' at compile-time -$VERSION = '1.14'; +$VERSION = '1.15'; @ISA = (); $MATCH_SUPERS = 1; @@ -186,27 +186,44 @@ sub maketext { # Look up the value: my $value; - foreach my $h_r ( - @{ $isa_scan{ref($handle) || $handle} || $handle->_lex_refs } - ) { - DEBUG and warn "* Looking up \"$phrase\" in $h_r\n"; - if(exists $h_r->{$phrase}) { - DEBUG and warn " Found \"$phrase\" in $h_r\n"; - unless(ref($value = $h_r->{$phrase})) { - # Nonref means it's not yet compiled. Compile and replace. - $value = $h_r->{$phrase} = $handle->_compile($value); + if (exists $handle->{'_external_lex_cache'}{$phrase}) { + DEBUG and warn "* Using external lex cache version of \"$phrase\"\n"; + $value = $handle->{'_external_lex_cache'}{$phrase}; + } + else { + foreach my $h_r ( + @{ $isa_scan{ref($handle) || $handle} || $handle->_lex_refs } + ) { + DEBUG and warn "* Looking up \"$phrase\" in $h_r\n"; + if(exists $h_r->{$phrase}) { + DEBUG and warn " Found \"$phrase\" in $h_r\n"; + unless(ref($value = $h_r->{$phrase})) { + # Nonref means it's not yet compiled. Compile and replace. + if ($handle->{'use_external_lex_cache'}) { + $value = $handle->{'_external_lex_cache'}{$phrase} = $handle->_compile($value); + } + else { + $value = $h_r->{$phrase} = $handle->_compile($value); + } + } + last; } - last; - } - elsif($phrase !~ m/^_/s and $h_r->{'_AUTO'}) { - # it's an auto lex, and this is an autoable key! - DEBUG and warn " Automaking \"$phrase\" into $h_r\n"; - - $value = $h_r->{$phrase} = $handle->_compile($phrase); - last; + # extending packages need to be able to localize _AUTO and if readonly can't "local $h_r->{'_AUTO'} = 1;" + # but they can "local $handle->{'_external_lex_cache'}{'_AUTO'} = 1;" + elsif($phrase !~ m/^_/s and ($handle->{'use_external_lex_cache'} ? ( exists $handle->{'_external_lex_cache'}{'_AUTO'} ? $handle->{'_external_lex_cache'}{'_AUTO'} : $h_r->{'_AUTO'} ) : $h_ ... [16 chars truncated] + # it's an auto lex, and this is an autoable key! + DEBUG and warn " Automaking \"$phrase\" into $h_r\n"; + if ($handle->{'use_external_lex_cache'}) { + $value = $handle->{'_external_lex_cache'}{$phrase} = $handle->_compile($phrase); + } + else { + $value = $h_r->{$phrase} = $handle->_compile($phrase); + } + last; + } + DEBUG>1 and print " Not found in $h_r, nor automakable\n"; + # else keep looking } - DEBUG>1 and print " Not found in $h_r, nor automakable\n"; - # else keep looking } unless(defined($value)) { diff --git a/dist/Locale-Maketext/lib/Locale/Maketext.pod b/dist/Locale-Maketext/lib/Locale/Maketext.pod index 15533e4..14b47c8 100644 --- a/dist/Locale-Maketext/lib/Locale/Maketext.pod +++ b/dist/Locale-Maketext/lib/Locale/Maketext.pod @@ -937,6 +937,25 @@ lexicon keys be autoable, except for possibly a few, and I arbitrarily decided to use a leading underscore as a signal to distinguish those few. +=head1 READONLY LEXICONS + +If your lexicon is a tied hash the simple act of caching the compiled value can be fatal. + +For example a L<GDBM_File> GDBM_READER tied hash will die with something like: + + gdbm store returned -1, errno 2, key "..." at ... + +All you need to do is turn on caching outside of the lexicon hash itself like so: + + sub init { + my ($lh) = @_; + ... + $lh->{'use_external_lex_cache'} = 1; + ... + } + +And then instead of storing the compiled value in the lexicon hash it will store it in $lh->{'_external_lex_cache'} + =head1 CONTROLLING LOOKUP FAILURE If you call $lh->maketext(I<key>, ...parameters...), diff --git a/dist/Locale-Maketext/t/04_use_external_lex_cache.t b/dist/Locale-Maketext/t/04_use_external_lex_cache.t new file mode 100644 index 0000000..97e7446 --- /dev/null +++ b/dist/Locale-Maketext/t/04_use_external_lex_cache.t @@ -0,0 +1,38 @@ +use Test::More tests => 11; + +BEGIN { + use_ok('Locale::Maketext'); +}; + +package MyTestLocale; + +...@mytestlocale::ISA = qw(Locale::Maketext); +%MyTestLocale::Lexicon = (); +%MyTestLocale::Lexicon = (); # to avoid warnings + +package MyTestLocale::fr; + +...@mytestlocale::fr::ISA = qw(MyTestLocale); + +%MyTestLocale::fr::Lexicon = ( + '_AUTO' => 1, + 'Hello World' => 'Bonjour Monde', +); + +package main; + +my $lh = MyTestLocale->get_handle('fr'); +$lh->{'use_external_lex_cache'} = 1; +ok(exists $MyTestLocale::fr::Lexicon{'Hello World'} && !ref $MyTestLocale::fr::Lexicon{'Hello World'}, 'lex value not a ref'); + +is($lh->maketext('Hello World'), 'Bonjour Monde', 'renders correctly first time'); +ok(exists $lh->{'_external_lex_cache'}{'Hello World'} && ref $lh->{'_external_lex_cache'}{'Hello World'}, 'compiled into lex_cache'); +ok(exists $MyTestLocale::fr::Lexicon{'Hello World'} && !ref $MyTestLocale::fr::Lexicon{'Hello World'}, 'lex value still not a ref'); + +is($lh->maketext('Hello World'), 'Bonjour Monde', 'renders correctly second time time'); +ok(exists $lh->{'_external_lex_cache'}{'Hello World'} && ref $lh->{'_external_lex_cache'}{'Hello World'}, 'still compiled into lex_cache'); +ok(exists $MyTestLocale::fr::Lexicon{'Hello World'} && !ref $MyTestLocale::fr::Lexicon{'Hello World'}, 'lex value still not a ref'); + +is($lh->maketext('This is not a key'), 'This is not a key', '_AUTO renders correctly first time'); +ok(exists $lh->{'_external_lex_cache'}{'This is not a key'} && ref $lh->{'_external_lex_cache'}{'This is not a key'}, '_AUTO compiled into lex_cache'); +ok(!exists $MyTestLocale::fr::Lexicon{'This is not a key'}, '_AUTO lex value not added to lex'); -- Perl5 Master Repository
