Skip Menu |
 

Preferred bug tracker

Please visit the preferred bug tracker to report your issue.

This queue is for tickets about the Locale-Maketext CPAN distribution.

Report information
The Basics
Id: 47315
Status: rejected
Priority: 0/
Queue: Locale-Maketext

People
Owner: Nobody in particular
Requestors: dmuey [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: [1.14 target - item #1] Lexicon object support
Download (untitled) / with headers
text/plain 438b
Here is a patch that adds: - Lexicon object support - version bump to 1.13_83 - change log entry - POD - test file (in MANIFEST) All existing tests still pass, and new tests all pass. As you can see it is very unobtrusive and should work fine with existing uses of Maketext. Added overhead to non-object Lexicons (i.e. all existing %lexicons) is one call to ref() to set a boolean and 2 or 3 if()/unless()s on said boolean.
Subject: lex_obj.patch
Download lex_obj.patch
text/x-diff 9.1k
diff -ruN /Users/dmuey/Downloads/Locale-Maketext-1.13_82/ChangeLog Locale-Maketext-1.13_83/ChangeLog --- /Users/dmuey/Downloads/Locale-Maketext-1.13_82/ChangeLog 2009-06-23 21:29:36.000000000 -0500 +++ Locale-Maketext-1.13_83/ChangeLog 2009-06-24 14:10:26.000000000 -0500 @@ -1,5 +1,10 @@ Revision history for Perl suite Locale::Maketext +2009-06-24 Adriano Ferreira + * Development release 1.13_83 + + added "Object Lexicon" support (thanks Dan Muey) + 2009-06-23 Adriano Ferreira * Development release 1.13_82 diff -ruN /Users/dmuey/Downloads/Locale-Maketext-1.13_82/MANIFEST Locale-Maketext-1.13_83/MANIFEST --- /Users/dmuey/Downloads/Locale-Maketext-1.13_82/MANIFEST 2009-06-23 19:16:50.000000000 -0500 +++ Locale-Maketext-1.13_83/MANIFEST 2009-06-24 14:14:15.000000000 -0500 @@ -20,5 +20,6 @@ t/60_super.t t/70_fail_auto.t t/90_utf8.t +t/91_object_lexicons.t t/pod.t META.yml Module meta-data (added by MakeMaker) diff -ruN /Users/dmuey/Downloads/Locale-Maketext-1.13_82/lib/Locale/Maketext.pm Locale-Maketext-1.13_83/lib/Locale/Maketext.pm --- /Users/dmuey/Downloads/Locale-Maketext-1.13_82/lib/Locale/Maketext.pm 2009-06-23 21:23:47.000000000 -0500 +++ Locale-Maketext-1.13_83/lib/Locale/Maketext.pm 2009-06-24 14:59:38.000000000 -0500 @@ -10,7 +10,7 @@ BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } } # define the constant 'DEBUG' at compile-time -$VERSION = '1.13_82'; +$VERSION = '1.13_83'; $VERSION = eval $VERSION; @ISA = (); @@ -190,11 +190,20 @@ @{ $isa_scan{ref($handle) || $handle} || $handle->_lex_refs } ) { DEBUG and warn "* Looking up \"$phrase\" in $h_r\n"; - if(exists $h_r->{$phrase}) { + + my $h_r_is_obj = ref $h_r ne 'HASH' ? 1 : 0; # tied() hashes still ref() to 'HASH') + if ( $h_r_is_obj ? $h_r->phrase_exists($phrase) : exists $h_r->{$phrase} ) { DEBUG and warn " Found \"$phrase\" in $h_r\n"; - unless(ref($value = $h_r->{$phrase})) { + unless ( ref( $value = $h_r_is_obj ? $h_r->get_phrase($phrase) : $h_r->{$phrase} ) ) { # Nonref means it's not yet compiled. Compile and replace. - $value = $h_r->{$phrase} = $handle->_compile($value); + + $value = $handle->_compile($value); + if ($h_r_is_obj) { + $h_r->set_phrase($phrase, $value); + } + else { + $h_r->{$phrase} = $value; + } } last; } @@ -202,7 +211,14 @@ # 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); + $value = $handle->_compile($phrase); + if ($h_r_is_obj) { + $h_r->set_phrase($phrase, $value); + } + else { + $h_r->{$phrase} = $value; + } + last; } DEBUG>1 and warn " Not found in $h_r, nor automakable\n"; diff -ruN /Users/dmuey/Downloads/Locale-Maketext-1.13_82/lib/Locale/Maketext.pod Locale-Maketext-1.13_83/lib/Locale/Maketext.pod --- /Users/dmuey/Downloads/Locale-Maketext-1.13_82/lib/Locale/Maketext.pod 2009-06-20 14:49:46.000000000 -0500 +++ Locale-Maketext-1.13_83/lib/Locale/Maketext.pod 2009-06-24 14:57:41.000000000 -0500 @@ -856,6 +856,74 @@ to nest bracket groups, but you are welcome to email me with convincing (real-life) arguments to the contrary. +=head1 WORKING WITH COMPLEX LEXICON REQUIREMENTS + +Lets say you want more complex behavior than a normal hash can offer. You have a few options: + +=over 4 + +=item * Inheritance + +You could use inheritance to implement, say, a sort of lexicon stack. + +The problem is you can't have anything take precedence over the working locale's lexicon since it'd mean a package would have to ISA itself in the middle of the list... + +=item * tied hashes + +You could make your lexicon as complex as you like via a tied hash. + +For example to implement a nice lexicon stack that allows adding/removing override and fallback hashes (which can be normal hashes or tied hashes themselves) as needed you could use the method described here: L<Locale::Maketext::Utils/"Tie::Hash::ReadonlyStack compat Lexicon"> + +The rare problem with a tie() is there are environments when a tie() is undesirable for one reason or another. + +=item * %Lexicon object + +You can now make your %Lexicon an object that has or inherits 4 metheds that allow you the flexibility of a tie() but in a non-tie object. + +By way of example: + +In package MyProj: + + @MyProj::ISA = ('Locale::Maketext'); + + %MyProj::Lexicon ( + ... complex structure goes here ... + ); + bless \%MyProj::Lexicon; + + sub phrase_exists { + my ($self, $phrase) = @_; + ... existence done on complex structure goes here ... + } + + sub get_phrase { + my ($self, $phrase) = @_; + ... getting value from complex structure goes here ... + } + + sub set_phrase { + my ($self, $phrase, $compiled) = @_; + ... setting value from complex structure goes here ... + } + + sub get_entry_count { + my ($self) = @_; + ... getting entry count from complex structure goes here ... + } + +in package MyProj::fr (it's own object %Lexicon) + + @MyProj::fr::ISA = ('MyProj'); + + %MyProj::fr:Lexicon ( + ... complex structure for french goes here ... + ); + bless \%MyProj::fr::Lexicon; + + # object metheds are inherited from ISA + +=back + =head1 AUTO LEXICONS If maketext goes to look in an individual %Lexicon for an entry diff -ruN /Users/dmuey/Downloads/Locale-Maketext-1.13_82/t/91_object_lexicons.t Locale-Maketext-1.13_83/t/91_object_lexicons.t --- /Users/dmuey/Downloads/Locale-Maketext-1.13_82/t/91_object_lexicons.t 1969-12-31 18:00:00.000000000 -0600 +++ Locale-Maketext-1.13_83/t/91_object_lexicons.t 2009-06-24 14:57:20.000000000 -0500 @@ -0,0 +1,105 @@ +use Test::More tests => 18; + +BEGIN { + use_ok('Locale::Maketext'); +}; + +{ + package TestApp::Localize; + our @ISA = ('Locale::Maketext'); + our %Lexicon = ( + 'lex' => { + 'in parent' => 'in parent', + 'both' => 'in parent', + }, + ); + + bless \%Lexicon; + + sub phrase_exists { + my ($self, $phrase) = @_; + Test::More::diag("in phrase_exists()"); + exists $self->{'lex'}{$phrase}; + } + + sub get_phrase { + my ($self, $phrase) = @_; + Test::More::diag("in get_phrase()"); + $self->{'lex'}{$phrase} + } + + sub set_phrase { + my ($self, $phrase, $value) = @_; + Test::More::diag("in set_phrase()"); + $self->{'lex'}{$phrase} = $value; + } + + sub get_entry_count { + my ($self) = @_; + return scalar(keys %{$self->{'lex'}}); + } +} + +{ + package TestApp::Localize::en; + our @ISA = ('TestApp::Localize'); + + no warnings 'once'; + *TestApp::Localize::en::Lexicon = *TestApp::Localize::Lexicon; +} + +{ + package TestApp::Localize::i_obj; + our @ISA = ('TestApp::Localize'); + our %Lexicon = ( + 'lex' => { + 'both' => 'in obj', + 'in child o' => 'in child o', + }, + ); + bless \%Lexicon; +} +{ + package TestApp::Localize::i_hash; + our @ISA = ('TestApp::Localize'); + our %Lexicon = ( + 'both' => 'in child', + 'in child' => 'in child', + ); +} + + +my $i_hash = TestApp::Localize->get_handle('i_hash'); +my $i_obj = TestApp::Localize->get_handle('i_obj'); +my $en = TestApp::Localize->get_handle('en'); +my $base = TestApp::Localize->get_handle(); + +ok($TestApp::Localize::Lexicon{'lex'}->{'both'} eq 'in parent', 'lex obj pre-compile string'); +ok(!ref $TestApp::Localize::Lexicon{'lex'}->{'both'}, 'lex obj pre-compile ref'); +ok($base->maketext('both') eq 'in parent', 'base multi'); +ok(${$TestApp::Localize::Lexicon{'lex'}->{'both'}} eq 'in parent', 'lex obj pre-compile string'); +ok(ref $TestApp::Localize::Lexicon{'lex'}->{'both'} eq 'SCALAR', 'lex obj pre-compile ref'); + +ok($base->maketext('in parent') eq 'in parent', 'base only'); + +ok($en->maketext('both') eq 'in parent', 'base alias multi'); +ok($en->maketext('in parent') eq 'in parent', 'base alias only'); + +ok($i_hash->maketext('in child') eq 'in child', 'child only'); +ok($i_hash->maketext('both') eq 'in child', 'child multi'); +ok($i_hash->maketext('in parent') eq 'in parent', 'fall back to parent'); + +ok($i_obj->maketext('in child o') eq 'in child o', 'child only'); +ok($i_obj->maketext('both') eq 'in obj', 'child multi'); +ok($i_obj->maketext('in parent') eq 'in parent', 'fall back to parent'); + +for my $class qw(TestApp::Localize::i_hash TestApp::Localize::en TestApp::Localize) { + # normal hash, ISA w/ parent that is object, is object + + ok( + "concat " . (ref \%{ $class . '::Lexicon' } ne 'HASH' ? *{ $class . '::Lexicon' }{'HASH'}->get_entry_count() : scalar( keys %{ $class . '::Lexicon' } ) ) . " concat" + eq + 'concat 2 concat', + "object get_entry_count() in debug message matches normal hash ($class)" + ); +} \ No newline at end of file
normal hash or tied hash + rt 46738 == everything an obj lex would cover but w/ out the overhead


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.