diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..ac25aa6
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,259 @@
+Revision history for Perl suite Locale::Maketext
+
+2016-07-25
+ * Release of 1.28 to CPAN
+ * Fix optional runtime load for CVE-2016-1238
+
+2016-06-22
+ * Release of 1.27 to CPAN
+
+2016-04-20
+ * perl #127923: note priority between the white and blacklist
+
+2016-03-17
+ * Add blacklist and whitelist support to Locale::Maketext.
+
+2014-06-17
+ * Correct two subtle typos in Locale::Maketext POD.
+
+
+2013-04-13
+ * No changes. Switch to version 1.25 for release to CPAN.
+
+2013-04-13
+ * Update to 1.25_01 from upstream blead for release testing
+
+2013-11-08
+ * Fix for case when lexicon translations contain substitionand literals with eval-non-safe characters.
+ RT #120457
+
+2013-08-21
+ * Swap out base for parent (bowtie) For: RT #119403
+
+2013-05-21
+ * typo fixes for Locale::Maketext
+
+2013-01-04
+ * POD fixes uncovered by the new Pod::Checker, not yet in core.
+
+2012-12-04
+ * Fix misparsing of maketext strings.
+
+2012-11-22
+ * Fix hash order dependency bug in tests
+
+2012-01-14
+ * Minor POD documentation update to sync with upstream blead.
+
+2011-12-23
+ * No changes. Production release after CPAN testers cleared.
+
+2011-12-14
+ * Update to 1.19_01 from upstream blead for release testing
+
+ Fix broken URLs in dist/Locale-Maketext/lib/Locale/Maketext/TPJ13.pod for RFCs
+
+ Keep verbatim pod in various dist/* pods within 79 cols
+
+2011-05-25
+ * Update to 1.19 from upstream blead
+
+ [perl #89896] Locale::Maketext test failure
+ when environment has variable containing unbalanced brackets
+
+ Suppress "Name used only once" warnings.
+
+ [perl #81888] Fix typos (spelling errors) in dist/*
+
+2010-10-20
+ * Release 1.17
+
+ Test release of 1.16_01, versioning even deprecated Guts modules.
+ This prevents CPAN upgrade circular heck. Thanks BinGOs
+
+ Tested version fix for CPAN by BinGOs. Bump to stable version and release to public
+
+2010-10-07
+ * Release 1.16
+
+ Blead commit bac7bf8 - Copy @_ to @_ to de-alias passed variables
+ to assure that the aliases cannot be altered during maketext calls.
+
+ Fix for CPAN RT #40727: infinite loop in
+ Locale::Maketext::Guts::_compile() when working with tainted values
+
+ Fix for CPAN RT #34182: Don't localize $@.
+ ->maketext calls will now backup and restore $@ so that die messages are not suppressed.
+
+ Fix for CPAN RT #55461
+ %hash deprecated messages cleaned up with perl 5.12
+
+ Fix for CPAN RT #48118. Perl 76674
+ Speed and efficiency tweaks in _compile calls when string has no ~][ in it.
+
+ Fix for CPAN RT #48808. Perl 76668
+ I18N::LangTags use() fixups.
+
+2010-06-22
+ * Release 1.15 (included in perl 5.13.3; not released separately)
+
+ Locale::Maketext guts have been merged back into the main module
+
+ Fix for CPAN RT #46738. Perl 76354
+ Support for RO Lexicon hashes (External cache support)
+
+2009-11-20
+ * Release 1.14 (included in perl 5.11.2; not released separately)
+
+ In Locale::Maketext, avoid using defined @array and defined %hash.
+
+ Convert the odd Locale::Maketext test out from Test to Test::More.
+
+2009-06-23 Adriano Ferreira
+ * Development release 1.13_82
+
+ One more recipe: on [numf,...] with decimal precision
+
+2009-06-23 Adriano Ferreira
+ * Development release 1.13_81
+
+ Change a few straggling 'DEBUG and print' to 'DEBUG and warn' (thanks Dan Muey)
+
+ A start of a cookbook.
+
+2009-06-23 Adriano Ferreira
+ * Development release 1.13_80
+
+ Fixes CPAN RT #25877 (thanks imacat)
+
+ Add a test for failure_handler_auto()
+
+2008-05-28 Adriano Ferreira
+ * Release 1.13
+
+ New maintainer. No noteworthy changes.
+
+ When debugging is turned on, "DEBUG and warn" is now
+ used instead of "DEBUG and print". It makes web applications
+ happier. CPAN RT #36238
+
+2007-11-17
+ * Release 1.12
+
+ Many doc changes from RT.
+
+ Silenced some "used only once" warnings under Perl 5.10.
+
+ $@ is now localized in case it gets interpolated. This was added
+ a while ago, but now there's a test for it, too.
+
+ Added warnings and strict to tests.
+
+ Cleaning up some Perl::Critic gripes.
+
+2007-05-07 Andy Lester
+ * Release 1.11_01
+
+ Fixed perlbug #33938
+ http://rt.perl.org/rt3//Public/Bug/Display.html?id=3393
+
+ Started cleaning up source per Perl::Critic.
+
+
+2005-11-10 Andy Lester
+ * Release 1.10:
+
+ New maintainer. No changes at all. Bumped up the version number
+ and released it so that I can get the RT queue and any future mail.
+
+
+2004-03-30 Sean M. Burke sburke@cpan.org
+ * Release 1.09:
+
+ * Moved the language-preference-detecting code into new module
+ I18N::LangTags::Detect.
+
+ Thanks to Autrijus Tang for catching some errors in the dist!
+
+
+2004-01-19 Sean M. Burke sburke@cpan.org
+
+ * Release 1.08:
+
+ * Corrected a one-line code bug in v1.07 that accidentally demoted
+ all en-* tags in cases of lexicon-groups that had an en.pm but no
+ en_*.pm. Thanks to Robert Spier for spotting this. Test added.
+ So don't use v1.07!
+
+ * Autrijus found some typos in the TPJ article. Fixed.
+
+2004-01-11 Sean M. Burke sburke@cpan.org
+
+ * Release 1.07: Now uses a new and different rule for implicating
+ superordinate language tags in accept-language lists. Previously,
+ superordinates were just tacked onto the, so "en-US, ja", turned
+ into "en-US, ja, en". However, this turned out to be suboptimal
+ for many users of RT, a popular system using Maketext. The new
+ rule is that a tag implicates superordinate forms right after it,
+ unless those tags are explicitly stated elsewhere in the
+ accept-languages list. So "en-US ja" becomes "en-US en ja". If
+ you want "en" to be really lower, you have to actually state it
+ there: "en-US ja en" is left as-is.
+
+ The 04super.t and 05super.t tests in t/ have many many examples of
+ this, including some strange corner cases.
+
+ (In implementing this change, I also refactored some code in
+ Maketext.pm, for hopefully improved readability. However,
+ the above is the only actual change in behavior.)
+
+2003-06-21 Sean M. Burke sburke@cpan.org
+ * Release 1.06: Now has "use utf8" to make the things work
+ happily. Some fancy footwork is required to make this work under
+ pre-utf8 perl versions.
+
+2003-04-18 Sean M. Burke sburke@cpan.org
+ * Release 1.05: Different Makefile.PL, same .pm code.
+
+ Jesse Vincent, Hugo van der Sanden, and Jarkko Hietaniemi
+ encourage me to add this to the makefile:
+ ($] < 5.008) ? () : ( INSTALLDIRS => 'perl'),
+ so that when you install this on a recent version of perl (5.8 or
+ later), the installation will overwrite the Maketext.pm in your
+ core library directory. Email me if this produces trouble for any
+ of you folks out there, okay?
+
+2003-04-02 Sean M. Burke sburke@cpan.org
+ * Release 1.04: Implementing proper HTTP "tag;q=rank" parsing for
+ get_handle. This should make all the difference for users/victims
+ of the current version of Safari, which uses that syntax as well
+ as inserts random languages with low q numbers.
+ Thanks to Jesse Vincent and the whole RT junta for finding this.
+
+ * Added more tests, now in t/
+
+ * Lots of typo fixes to Maketext.pm. Thanks to Evan A. Zacks for
+ patient help in finding them all.
+
+2001-06-21 Sean M. Burke sburke@cpan.org
+ * Release 1.03: basically cosmetic tweaks to the docs and the
+ test.pl.
+
+2001-06-20 Sean M. Burke sburke@cpan.org
+ * Release 1.02: EBCDIC-compatibility changes courtesy of Peter
+ Prymmer. Added [*,...] as alias for [quant,...] and [#,...] as an
+ alias for [numf,...]. Added some more things to test.pl
+
+2001-05-25 Sean M. Burke sburke@cpan.org
+ * Release 1.01: total rewrite. Docs are massive now.
+ Including TPJ13 article now.
+
+2000-05-14 Sean M. Burke sburke@cpan.org
+
+ * Release 0.18: only change, regrettably, is a better makefile,
+ and it my email address has changed.
+
+1999-03-15 Sean M. Burke sburke@netadventure.net
+
+ * Release 0.17: Public alpha release
+ Underdocumented.
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..f13277a
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,30 @@
+ChangeLog
+lib/Locale/Maketext.pm
+lib/Locale/Maketext.pod
+lib/Locale/Maketext/Cookbook.pod
+lib/Locale/Maketext/Guts.pm
+lib/Locale/Maketext/GutsLoader.pm
+lib/Locale/Maketext/TPJ13.pod
+Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+META.json
+META.yml Module meta-data (added by MakeMaker)
+perlcriticrc
+README
+t/00_load.t
+t/01_about_verbose.t
+t/04_use_external_lex_cache.t
+t/09_compile.t
+t/10_make.t
+t/20_get.t
+t/30_eval_dollar_at.t
+t/40_super.t
+t/50_super.t
+t/60_super.t
+t/70_fail_auto.t
+t/90_utf8.t
+t/91_backslash.t
+t/92_blacklist.t
+t/93_whitelist.t
+t/pod.t
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..246bd3a
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,9 @@
+^MANIFEST\.bak$
+Makefile(\.old)?$
+\.rej$
+CVS
+blib
+~
+.git
+.gitignore$
+Makefile$
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..94f1b90
--- /dev/null
+++ b/META.json
@@ -0,0 +1,55 @@
+{
+ "abstract" : "framework for localization",
+ "author" : [
+ "unknown"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Locale-Maketext",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "I18N::LangTags" : "0.31",
+ "I18N::LangTags::Detect" : "0",
+ "Test::More" : "0"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "web" : "http://rt.perl.org/perlbug/"
+ },
+ "license" : [
+ "http://dev.perl.org/licenses/"
+ ],
+ "repository" : {
+ "url" : "http://perl5.git.perl.org/perl.git/tree/HEAD:/dist/Locale-Maketext"
+ },
+ "x_MailingList" : "http://lists.perl.org/list/perl5-porters.html"
+ },
+ "version" : "1.28"
+}
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..587cd49
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,29 @@
+---
+abstract: 'framework for localization'
+author:
+ - unknown
+build_requires:
+ ExtUtils::MakeMaker: '0'
+configure_requires:
+ ExtUtils::MakeMaker: '0'
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: '1.4'
+name: Locale-Maketext
+no_index:
+ directory:
+ - t
+ - inc
+requires:
+ I18N::LangTags: '0.31'
+ I18N::LangTags::Detect: '0'
+ Test::More: '0'
+resources:
+ MailingList: http://lists.perl.org/list/perl5-porters.html
+ bugtracker: http://rt.perl.org/perlbug/
+ license: http://dev.perl.org/licenses/
+ repository: http://perl5.git.perl.org/perl.git/tree/HEAD:/dist/Locale-Maketext
+version: '1.28'
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..eba2a37
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,45 @@
+require 5.004;
+use strict;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Locale-Maketext',
+ VERSION_FROM => 'lib/Locale/Maketext.pm',
+ ABSTRACT_FROM => 'lib/Locale/Maketext.pod',
+ PREREQ_PM => {
+ 'I18N::LangTags' => 0.31,
+ 'I18N::LangTags::Detect' => 0,
+ 'Test::More' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE' => 'perl', ) : ()),
+ ($] < 5.008 && $] > 5.011) ? () : ( INSTALLDIRS => 'perl' ),
+ # If under a version with Maketext in core, overwrite that core file.
+ META_MERGE => {
+ resources => {
+ license => 'http://dev.perl.org/licenses/',
+# homepage => '',
+ bugtracker => 'http://rt.perl.org/perlbug/',
+ repository => 'http://perl5.git.perl.org/perl.git/tree/HEAD:/dist/Locale-Maketext',
+ MailingList => 'http://lists.perl.org/list/perl5-porters.html',
+ },
+ },
+);
+
+
+sub MY::postamble {
+ return <<'MAKE_FRAG';
+.PHONY: tags critic
+
+tags:
+ ctags -f tags --recurse --totals \
+ --exclude=blib \
+ --exclude=.svn \
+ --exclude='*~' \
+ --languages=Perl --langmap=Perl:+.t \
+
+critic:
+ perlcritic -1 -q -profile perlcriticrc -statistics lib/ t/
+
+MAKE_FRAG
+}
diff --git a/README b/README
new file mode 100644
index 0000000..55a2ff7
--- /dev/null
+++ b/README
@@ -0,0 +1,67 @@
+README for Locale::Maketext
+ Time-stamp: "2004-03-30 16:02:27 AST"
+
+ Locale::Maketext
+
+Locale::Maketext is a base class providing a framework for
+localization and inheritance-based lexicons, as described in my
+article in The Perl Journal #13 (a corrected version of which appears
+in this dist).
+
+
+PREREQUISITES
+
+This suite requires Perl 5. It also requires a recent version
+of I18N::LangTags. MSWin users should also get Win32::Locale.
+File::Findgrep is also useful example code, as is the rather
+larger Apache::MP3 source (even if you don't run Apache).
+
+
+INSTALLATION
+
+You install Locale::Maketext, as you would install any Perl module
+distribution, by running these commands:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+If you want to install a private copy of Maketext in your home directory,
+then you should try to produce the initial Makefile with something
+like this command:
+
+ perl Makefile.PL LIB=~/perl
+
+See perldoc perlmodinstall for more information.
+
+
+DOCUMENTATION
+
+See the pod in Locale::Maketext and Locale::Maketext::TPJ13,
+and see also File::Findgrep.
+
+
+SUPPORT
+
+Questions, bug reports, useful code bits, and suggestions for
+Worms should be sent to me at sburke@cpan.org
+
+
+AVAILABILITY
+
+The latest version of Locale::Maketext is available from the
+Comprehensive Perl Archive Network (CPAN). Visit
+ to find a CPAN site near you.
+
+
+COPYRIGHT
+
+Copyright 1999-2004, Sean M. Burke , all rights
+reserved. This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+
+AUTHOR
+
+Sean M. Burke
diff --git a/lib/Locale/Maketext.pm b/lib/Locale/Maketext.pm
new file mode 100644
index 0000000..36d0c05
--- /dev/null
+++ b/lib/Locale/Maketext.pm
@@ -0,0 +1,860 @@
+package Locale::Maketext;
+use strict;
+use vars qw( @ISA $VERSION $MATCH_SUPERS $USING_LANGUAGE_TAGS
+$USE_LITERALS $MATCH_SUPERS_TIGHTLY);
+use Carp ();
+use I18N::LangTags ();
+use I18N::LangTags::Detect ();
+
+#--------------------------------------------------------------------------
+
+BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } }
+# define the constant 'DEBUG' at compile-time
+
+# turn on utf8 if we have it (this is what GutsLoader.pm used to do essentially )
+# use if (exists $INC{'utf8.pm'} || eval 'use utf8'), 'utf8';
+BEGIN {
+
+ # if we have it || we can load it
+ if ( exists $INC{'utf8.pm'} || eval { local $SIG{'__DIE__'};require utf8; } ) {
+ utf8->import();
+ DEBUG and warn " utf8 on for _compile()\n";
+ }
+ else {
+ DEBUG and warn " utf8 not available for _compile() ($INC{'utf8.pm'})\n$@\n";
+ }
+}
+
+
+$VERSION = '1.28';
+@ISA = ();
+
+$MATCH_SUPERS = 1;
+$MATCH_SUPERS_TIGHTLY = 1;
+$USING_LANGUAGE_TAGS = 1;
+# Turning this off is somewhat of a security risk in that little or no
+# checking will be done on the legality of tokens passed to the
+# eval("use $module_name") in _try_use. If you turn this off, you have
+# to do your own taint checking.
+
+$USE_LITERALS = 1 unless defined $USE_LITERALS;
+# a hint for compiling bracket-notation things.
+
+my %isa_scan = ();
+
+###########################################################################
+
+sub quant {
+ my($handle, $num, @forms) = @_;
+
+ return $num if @forms == 0; # what should this mean?
+ return $forms[2] if @forms > 2 and $num == 0; # special zeroth case
+
+ # Normal case:
+ # Note that the formatting of $num is preserved.
+ return( $handle->numf($num) . ' ' . $handle->numerate($num, @forms) );
+ # Most human languages put the number phrase before the qualified phrase.
+}
+
+
+sub numerate {
+ # return this lexical item in a form appropriate to this number
+ my($handle, $num, @forms) = @_;
+ my $s = ($num == 1);
+
+ return '' unless @forms;
+ if(@forms == 1) { # only the headword form specified
+ return $s ? $forms[0] : ($forms[0] . 's'); # very cheap hack.
+ }
+ else { # sing and plural were specified
+ return $s ? $forms[0] : $forms[1];
+ }
+}
+
+#--------------------------------------------------------------------------
+
+sub numf {
+ my($handle, $num) = @_[0,1];
+ if($num < 10_000_000_000 and $num > -10_000_000_000 and $num == int($num)) {
+ $num += 0; # Just use normal integer stringification.
+ # Specifically, don't let %G turn ten million into 1E+007
+ }
+ else {
+ $num = CORE::sprintf('%G', $num);
+ # "CORE::" is there to avoid confusion with the above sub sprintf.
+ }
+ while( $num =~ s/^([-+]?\d+)(\d{3})/$1,$2/s ) {1} # right from perlfaq5
+ # The initial \d+ gobbles as many digits as it can, and then we
+ # backtrack so it un-eats the rightmost three, and then we
+ # insert the comma there.
+
+ $num =~ tr<.,><,.> if ref($handle) and $handle->{'numf_comma'};
+ # This is just a lame hack instead of using Number::Format
+ return $num;
+}
+
+sub sprintf {
+ no integer;
+ my($handle, $format, @params) = @_;
+ return CORE::sprintf($format, @params);
+ # "CORE::" is there to avoid confusion with myself!
+}
+
+#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#=#
+
+use integer; # vroom vroom... applies to the whole rest of the module
+
+sub language_tag {
+ my $it = ref($_[0]) || $_[0];
+ return undef unless $it =~ m/([^':]+)(?:::)?$/s;
+ $it = lc($1);
+ $it =~ tr<_><->;
+ return $it;
+}
+
+sub encoding {
+ my $it = $_[0];
+ return(
+ (ref($it) && $it->{'encoding'})
+ || 'iso-8859-1' # Latin-1
+ );
+}
+
+#--------------------------------------------------------------------------
+
+sub fallback_languages { return('i-default', 'en', 'en-US') }
+
+sub fallback_language_classes { return () }
+
+#--------------------------------------------------------------------------
+
+sub fail_with { # an actual attribute method!
+ my($handle, @params) = @_;
+ return unless ref($handle);
+ $handle->{'fail'} = $params[0] if @params;
+ return $handle->{'fail'};
+}
+
+#--------------------------------------------------------------------------
+
+sub blacklist {
+ my ( $handle, @methods ) = @_;
+
+ unless ( defined $handle->{'blacklist'} ) {
+ no strict 'refs';
+
+ # Don't let people call methods they're not supposed to from maketext.
+ # Explicitly exclude all methods in this package that start with an
+ # underscore on principle.
+ $handle->{'blacklist'} = {
+ map { $_ => 1 } (
+ qw/
+ blacklist
+ encoding
+ fail_with
+ failure_handler_auto
+ fallback_language_classes
+ fallback_languages
+ get_handle
+ init
+ language_tag
+ maketext
+ new
+ whitelist
+ /, grep { /^_/ } keys %{ __PACKAGE__ . "::" }
+ ),
+ };
+ }
+
+ if ( scalar @methods ) {
+ $handle->{'blacklist'} = { %{ $handle->{'blacklist'} }, map { $_ => 1 } @methods };
+ }
+
+ delete $handle->{'_external_lex_cache'};
+ return;
+}
+
+sub whitelist {
+ my ( $handle, @methods ) = @_;
+ if ( scalar @methods ) {
+ $handle->{'whitelist'} = {} unless defined $handle->{'whitelist'};
+ $handle->{'whitelist'} = { %{ $handle->{'whitelist'} }, map { $_ => 1 } @methods };
+ }
+
+ delete $handle->{'_external_lex_cache'};
+ return;
+}
+
+#--------------------------------------------------------------------------
+
+sub failure_handler_auto {
+ # Meant to be used like:
+ # $handle->fail_with('failure_handler_auto')
+
+ my $handle = shift;
+ my $phrase = shift;
+
+ $handle->{'failure_lex'} ||= {};
+ my $lex = $handle->{'failure_lex'};
+
+ my $value ||= ($lex->{$phrase} ||= $handle->_compile($phrase));
+
+ # Dumbly copied from sub maketext:
+ return ${$value} if ref($value) eq 'SCALAR';
+ return $value if ref($value) ne 'CODE';
+ {
+ local $SIG{'__DIE__'};
+ eval { $value = &$value($handle, @_) };
+ }
+ # If we make it here, there was an exception thrown in the
+ # call to $value, and so scream:
+ if($@) {
+ # pretty up the error message
+ $@ =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?}
+ {\n in bracket code [compiled line $1],}s;
+ #$err =~ s/\n?$/\n/s;
+ Carp::croak "Error in maketexting \"$phrase\":\n$@ as used";
+ # Rather unexpected, but suppose that the sub tried calling
+ # a method that didn't exist.
+ }
+ else {
+ return $value;
+ }
+}
+
+#==========================================================================
+
+sub new {
+ # Nothing fancy!
+ my $class = ref($_[0]) || $_[0];
+ my $handle = bless {}, $class;
+ $handle->blacklist;
+ $handle->init;
+ return $handle;
+}
+
+sub init { return } # no-op
+
+###########################################################################
+
+sub maketext {
+ # Remember, this can fail. Failure is controllable many ways.
+ Carp::croak 'maketext requires at least one parameter' unless @_ > 1;
+
+ my($handle, $phrase) = splice(@_,0,2);
+ Carp::confess('No handle/phrase') unless (defined($handle) && defined($phrase));
+
+ # backup $@ in case it's still being used in the calling code.
+ # If no failures, we'll re-set it back to what it was later.
+ my $at = $@;
+
+ # Copy @_ case one of its elements is $@.
+ @_ = @_;
+
+ # Look up the value:
+
+ my $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;
+ }
+ # 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_r->{'_AUTO'})) {
+ # 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
+ }
+ }
+
+ unless(defined($value)) {
+ DEBUG and warn "! Lookup of \"$phrase\" in/under ", ref($handle) || $handle, " fails.\n";
+ if(ref($handle) and $handle->{'fail'}) {
+ DEBUG and warn "WARNING0: maketext fails looking for <$phrase>\n";
+ my $fail;
+ if(ref($fail = $handle->{'fail'}) eq 'CODE') { # it's a sub reference
+ $@ = $at; # Put $@ back in case we altered it along the way.
+ return &{$fail}($handle, $phrase, @_);
+ # If it ever returns, it should return a good value.
+ }
+ else { # It's a method name
+ $@ = $at; # Put $@ back in case we altered it along the way.
+ return $handle->$fail($phrase, @_);
+ # If it ever returns, it should return a good value.
+ }
+ }
+ else {
+ # All we know how to do is this;
+ Carp::croak("maketext doesn't know how to say:\n$phrase\nas needed");
+ }
+ }
+
+ if(ref($value) eq 'SCALAR'){
+ $@ = $at; # Put $@ back in case we altered it along the way.
+ return $$value ;
+ }
+ if(ref($value) ne 'CODE'){
+ $@ = $at; # Put $@ back in case we altered it along the way.
+ return $value ;
+ }
+
+ {
+ local $SIG{'__DIE__'};
+ eval { $value = &$value($handle, @_) };
+ }
+ # If we make it here, there was an exception thrown in the
+ # call to $value, and so scream:
+ if ($@) {
+ # pretty up the error message
+ $@ =~ s{\s+at\s+\(eval\s+\d+\)\s+line\s+(\d+)\.?\n?}
+ {\n in bracket code [compiled line $1],}s;
+ #$err =~ s/\n?$/\n/s;
+ Carp::croak "Error in maketexting \"$phrase\":\n$@ as used";
+ # Rather unexpected, but suppose that the sub tried calling
+ # a method that didn't exist.
+ }
+ else {
+ $@ = $at; # Put $@ back in case we altered it along the way.
+ return $value;
+ }
+ $@ = $at; # Put $@ back in case we altered it along the way.
+}
+
+###########################################################################
+
+sub get_handle { # This is a constructor and, yes, it CAN FAIL.
+ # Its class argument has to be the base class for the current
+ # application's l10n files.
+
+ my($base_class, @languages) = @_;
+ $base_class = ref($base_class) || $base_class;
+ # Complain if they use __PACKAGE__ as a project base class?
+
+ if( @languages ) {
+ DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ if($USING_LANGUAGE_TAGS) { # An explicit language-list was given!
+ @languages =
+ map {; $_, I18N::LangTags::alternate_language_tags($_) }
+ # Catch alternation
+ map I18N::LangTags::locale2language_tag($_),
+ # If it's a lg tag, fine, pass thru (untainted)
+ # If it's a locale ID, try converting to a lg tag (untainted),
+ # otherwise nix it.
+ @languages;
+ DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ }
+ }
+ else {
+ @languages = $base_class->_ambient_langprefs;
+ }
+
+ @languages = $base_class->_langtag_munging(@languages);
+
+ my %seen;
+ foreach my $module_name ( map { $base_class . '::' . $_ } @languages ) {
+ next unless length $module_name; # sanity
+ next if $seen{$module_name}++ # Already been here, and it was no-go
+ || !&_try_use($module_name); # Try to use() it, but can't it.
+ return($module_name->new); # Make it!
+ }
+
+ return undef; # Fail!
+}
+
+###########################################################################
+
+sub _langtag_munging {
+ my($base_class, @languages) = @_;
+
+ # We have all these DEBUG statements because otherwise it's hard as hell
+ # to diagnose if/when something goes wrong.
+
+ DEBUG and warn 'Lgs1: ', map("<$_>", @languages), "\n";
+
+ if($USING_LANGUAGE_TAGS) {
+ DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ @languages = $base_class->_add_supers( @languages );
+
+ push @languages, I18N::LangTags::panic_languages(@languages);
+ DEBUG and warn "After adding panic languages:\n",
+ ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+
+ push @languages, $base_class->fallback_languages;
+ # You are free to override fallback_languages to return empty-list!
+ DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+
+ @languages = # final bit of processing to turn them into classname things
+ map {
+ my $it = $_; # copy
+ $it =~ tr<-A-Z><_a-z>; # lc, and turn - to _
+ $it =~ tr<_a-z0-9><>cd; # remove all but a-z0-9_
+ $it;
+ } @languages
+ ;
+ DEBUG and warn "Nearing end of munging:\n",
+ ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ }
+ else {
+ DEBUG and warn "Bypassing language-tags.\n",
+ ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ }
+
+ DEBUG and warn "Before adding fallback classes:\n",
+ ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+
+ push @languages, $base_class->fallback_language_classes;
+ # You are free to override that to return whatever.
+
+ DEBUG and warn "Finally:\n",
+ ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+
+ return @languages;
+}
+
+###########################################################################
+
+sub _ambient_langprefs {
+ return I18N::LangTags::Detect::detect();
+}
+
+###########################################################################
+
+sub _add_supers {
+ my($base_class, @languages) = @_;
+
+ if (!$MATCH_SUPERS) {
+ # Nothing
+ DEBUG and warn "Bypassing any super-matching.\n",
+ ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+
+ }
+ elsif( $MATCH_SUPERS_TIGHTLY ) {
+ DEBUG and warn "Before adding new supers tightly:\n",
+ ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ @languages = I18N::LangTags::implicate_supers( @languages );
+ DEBUG and warn "After adding new supers tightly:\n",
+ ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+
+ }
+ else {
+ DEBUG and warn "Before adding supers to end:\n",
+ ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ @languages = I18N::LangTags::implicate_supers_strictly( @languages );
+ DEBUG and warn "After adding supers to end:\n",
+ ' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
+ }
+
+ return @languages;
+}
+
+###########################################################################
+#
+# This is where most people should stop reading.
+#
+###########################################################################
+
+my %tried = ();
+# memoization of whether we've used this module, or found it unusable.
+
+sub _try_use { # Basically a wrapper around "require Modulename"
+ # "Many men have tried..." "They tried and failed?" "They tried and died."
+ return $tried{$_[0]} if exists $tried{$_[0]}; # memoization
+
+ my $module = $_[0]; # ASSUME sane module name!
+ { no strict 'refs';
+ no warnings 'once';
+ return($tried{$module} = 1)
+ if %{$module . '::Lexicon'} or @{$module . '::ISA'};
+ # weird case: we never use'd it, but there it is!
+ }
+
+ DEBUG and warn " About to use $module ...\n";
+
+ local $SIG{'__DIE__'};
+ local $@;
+ local @INC = @INC;
+ pop @INC if $INC[-1] eq '.';
+ eval "require $module"; # used to be "use $module", but no point in that.
+
+ if($@) {
+ DEBUG and warn "Error using $module \: $@\n";
+ return $tried{$module} = 0;
+ }
+ else {
+ DEBUG and warn " OK, $module is used\n";
+ return $tried{$module} = 1;
+ }
+}
+
+#--------------------------------------------------------------------------
+
+sub _lex_refs { # report the lexicon references for this handle's class
+ # returns an arrayREF!
+ no strict 'refs';
+ no warnings 'once';
+ my $class = ref($_[0]) || $_[0];
+ DEBUG and warn "Lex refs lookup on $class\n";
+ return $isa_scan{$class} if exists $isa_scan{$class}; # memoization!
+
+ my @lex_refs;
+ my $seen_r = ref($_[1]) ? $_[1] : {};
+
+ if( defined( *{$class . '::Lexicon'}{'HASH'} )) {
+ push @lex_refs, *{$class . '::Lexicon'}{'HASH'};
+ DEBUG and warn '%' . $class . '::Lexicon contains ',
+ scalar(keys %{$class . '::Lexicon'}), " entries\n";
+ }
+
+ # Implements depth(height?)-first recursive searching of superclasses.
+ # In hindsight, I suppose I could have just used Class::ISA!
+ foreach my $superclass (@{$class . '::ISA'}) {
+ DEBUG and warn " Super-class search into $superclass\n";
+ next if $seen_r->{$superclass}++;
+ push @lex_refs, @{&_lex_refs($superclass, $seen_r)}; # call myself
+ }
+
+ $isa_scan{$class} = \@lex_refs; # save for next time
+ return \@lex_refs;
+}
+
+sub clear_isa_scan { %isa_scan = (); return; } # end on a note of simplicity!
+
+#--------------------------------------------------------------------------
+
+sub _compile {
+ # This big scary routine compiles an entry.
+ # It returns either a coderef if there's brackety bits in this, or
+ # otherwise a ref to a scalar.
+
+ my $string_to_compile = $_[1]; # There are taint issues using regex on @_ - perlbug 60378,27344
+
+ # The while() regex is more expensive than this check on strings that don't need a compile.
+ # this op causes a ~2% speed hit for strings that need compile and a 250% speed improvement
+ # on strings that don't need compiling.
+ return \"$string_to_compile" if($string_to_compile !~ m/[\[~\]]/ms); # return a string ref if chars [~] are not in the string
+
+ my $handle = $_[0];
+
+ my(@code);
+ my(@c) = (''); # "chunks" -- scratch.
+ my $call_count = 0;
+ my $big_pile = '';
+ {
+ my $in_group = 0; # start out outside a group
+ my($m, @params); # scratch
+
+ while($string_to_compile =~ # Iterate over chunks.
+ m/(
+ [^\~\[\]]+ # non-~[] stuff (Capture everything else here)
+ |
+ ~. # ~[, ~], ~~, ~other
+ |
+ \[ # [ presumably opening a group
+ |
+ \] # ] presumably closing a group
+ |
+ ~ # terminal ~ ?
+ |
+ $
+ )/xgs
+ ) {
+ DEBUG>2 and warn qq{ "$1"\n};
+
+ if($1 eq '[' or $1 eq '') { # "[" or end
+ # Whether this is "[" or end, force processing of any
+ # preceding literal.
+ if($in_group) {
+ if($1 eq '') {
+ $handle->_die_pointing($string_to_compile, 'Unterminated bracket group');
+ }
+ else {
+ $handle->_die_pointing($string_to_compile, 'You can\'t nest bracket groups');
+ }
+ }
+ else {
+ if ($1 eq '') {
+ DEBUG>2 and warn " [end-string]\n";
+ }
+ else {
+ $in_group = 1;
+ }
+ die "How come \@c is empty?? in <$string_to_compile>" unless @c; # sanity
+ if(length $c[-1]) {
+ # Now actually processing the preceding literal
+ $big_pile .= $c[-1];
+ if($USE_LITERALS and (
+ (ord('A') == 65)
+ ? $c[-1] !~ m/[^\x20-\x7E]/s
+ # ASCII very safe chars
+ : $c[-1] !~ m/[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/s
+ # EBCDIC very safe chars
+ )) {
+ # normal case -- all very safe chars
+ $c[-1] =~ s/'/\\'/g;
+ push @code, q{ '} . $c[-1] . "',\n";
+ $c[-1] = ''; # reuse this slot
+ }
+ else {
+ $c[-1] =~ s/\\\\/\\/g;
+ push @code, ' $c[' . $#c . "],\n";
+ push @c, ''; # new chunk
+ }
+ }
+ # else just ignore the empty string.
+ }
+
+ }
+ elsif($1 eq ']') { # "]"
+ # close group -- go back in-band
+ if($in_group) {
+ $in_group = 0;
+
+ DEBUG>2 and warn " --Closing group [$c[-1]]\n";
+
+ # And now process the group...
+
+ if(!length($c[-1]) or $c[-1] =~ m/^\s+$/s) {
+ DEBUG>2 and warn " -- (Ignoring)\n";
+ $c[-1] = ''; # reset out chink
+ next;
+ }
+
+ #$c[-1] =~ s/^\s+//s;
+ #$c[-1] =~ s/\s+$//s;
+ ($m,@params) = split(/,/, $c[-1], -1); # was /\s*,\s*/
+
+ # A bit of a hack -- we've turned "~,"'s into DELs, so turn
+ # 'em into real commas here.
+ if (ord('A') == 65) { # ASCII, etc
+ foreach($m, @params) { tr/\x7F/,/ }
+ }
+ else { # EBCDIC (1047, 0037, POSIX-BC)
+ # Thanks to Peter Prymmer for the EBCDIC handling
+ foreach($m, @params) { tr/\x07/,/ }
+ }
+
+ # Special-case handling of some method names:
+ if($m eq '_*' or $m =~ m/^_(-?\d+)$/s) {
+ # Treat [_1,...] as [,_1,...], etc.
+ unshift @params, $m;
+ $m = '';
+ }
+ elsif($m eq '*') {
+ $m = 'quant'; # "*" for "times": "4 cars" is 4 times "cars"
+ }
+ elsif($m eq '#') {
+ $m = 'numf'; # "#" for "number": [#,_1] for "the number _1"
+ }
+
+ # Most common case: a simple, legal-looking method name
+ if($m eq '') {
+ # 0-length method name means to just interpolate:
+ push @code, ' (';
+ }
+ elsif($m =~ /^\w+$/s
+ && !$handle->{'blacklist'}{$m}
+ && ( !defined $handle->{'whitelist'} || $handle->{'whitelist'}{$m} )
+ # exclude anything fancy and restrict to the whitelist/blacklist.
+ ) {
+ push @code, ' $_[0]->' . $m . '(';
+ }
+ else {
+ # TODO: implement something? or just too icky to consider?
+ $handle->_die_pointing(
+ $string_to_compile,
+ "Can't use \"$m\" as a method name in bracket group",
+ 2 + length($c[-1])
+ );
+ }
+
+ pop @c; # we don't need that chunk anymore
+ ++$call_count;
+
+ foreach my $p (@params) {
+ if($p eq '_*') {
+ # Meaning: all parameters except $_[0]
+ $code[-1] .= ' @_[1 .. $#_], ';
+ # and yes, that does the right thing for all @_ < 3
+ }
+ elsif($p =~ m/^_(-?\d+)$/s) {
+ # _3 meaning $_[3]
+ $code[-1] .= '$_[' . (0 + $1) . '], ';
+ }
+ elsif($USE_LITERALS and (
+ (ord('A') == 65)
+ ? $p !~ m/[^\x20-\x7E]/s
+ # ASCII very safe chars
+ : $p !~ m/[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~\x07]/s
+ # EBCDIC very safe chars
+ )) {
+ # Normal case: a literal containing only safe characters
+ $p =~ s/'/\\'/g;
+ $code[-1] .= q{'} . $p . q{', };
+ }
+ else {
+ # Stow it on the chunk-stack, and just refer to that.
+ push @c, $p;
+ push @code, ' $c[' . $#c . '], ';
+ }
+ }
+ $code[-1] .= "),\n";
+
+ push @c, '';
+ }
+ else {
+ $handle->_die_pointing($string_to_compile, q{Unbalanced ']'});
+ }
+
+ }
+ elsif(substr($1,0,1) ne '~') {
+ # it's stuff not containing "~" or "[" or "]"
+ # i.e., a literal blob
+ my $text = $1;
+ $text =~ s/\\/\\\\/g;
+ $c[-1] .= $text;
+
+ }
+ elsif($1 eq '~~') { # "~~"
+ $c[-1] .= '~';
+
+ }
+ elsif($1 eq '~[') { # "~["
+ $c[-1] .= '[';
+
+ }
+ elsif($1 eq '~]') { # "~]"
+ $c[-1] .= ']';
+
+ }
+ elsif($1 eq '~,') { # "~,"
+ if($in_group) {
+ # This is a hack, based on the assumption that no-one will actually
+ # want a DEL inside a bracket group. Let's hope that's it's true.
+ if (ord('A') == 65) { # ASCII etc
+ $c[-1] .= "\x7F";
+ }
+ else { # EBCDIC (cp 1047, 0037, POSIX-BC)
+ $c[-1] .= "\x07";
+ }
+ }
+ else {
+ $c[-1] .= '~,';
+ }
+
+ }
+ elsif($1 eq '~') { # possible only at string-end, it seems.
+ $c[-1] .= '~';
+
+ }
+ else {
+ # It's a "~X" where X is not a special character.
+ # Consider it a literal ~ and X.
+ my $text = $1;
+ $text =~ s/\\/\\\\/g;
+ $c[-1] .= $text;
+ }
+ }
+ }
+
+ if($call_count) {
+ undef $big_pile; # Well, nevermind that.
+ }
+ else {
+ # It's all literals! Ahwell, that can happen.
+ # So don't bother with the eval. Return a SCALAR reference.
+ return \$big_pile;
+ }
+
+ die q{Last chunk isn't null??} if @c and length $c[-1]; # sanity
+ DEBUG and warn scalar(@c), " chunks under closure\n";
+ if(@code == 0) { # not possible?
+ DEBUG and warn "Empty code\n";
+ return \'';
+ }
+ elsif(@code > 1) { # most cases, presumably!
+ unshift @code, "join '',\n";
+ }
+ unshift @code, "use strict; sub {\n";
+ push @code, "}\n";
+
+ DEBUG and warn @code;
+ my $sub = eval(join '', @code);
+ die "$@ while evalling" . join('', @code) if $@; # Should be impossible.
+ return $sub;
+}
+
+#--------------------------------------------------------------------------
+
+sub _die_pointing {
+ # This is used by _compile to throw a fatal error
+ my $target = shift;
+ $target = ref($target) || $target; # class name
+ # ...leaving $_[0] the error-causing text, and $_[1] the error message
+
+ my $i = index($_[0], "\n");
+
+ my $pointy;
+ my $pos = pos($_[0]) - (defined($_[2]) ? $_[2] : 0) - 1;
+ if($pos < 1) {
+ $pointy = "^=== near there\n";
+ }
+ else { # we need to space over
+ my $first_tab = index($_[0], "\t");
+ if($pos > 2 and ( -1 == $first_tab or $first_tab > pos($_[0]))) {
+ # No tabs, or the first tab is harmlessly after where we will point to,
+ # AND we're far enough from the margin that we can draw a proper arrow.
+ $pointy = ('=' x $pos) . "^ near there\n";
+ }
+ else {
+ # tabs screw everything up!
+ $pointy = substr($_[0],0,$pos);
+ $pointy =~ tr/\t //cd;
+ # make everything into whitespace, but preserving tabs
+ $pointy .= "^=== near there\n";
+ }
+ }
+
+ my $errmsg = "$_[1], in\:\n$_[0]";
+
+ if($i == -1) {
+ # No newline.
+ $errmsg .= "\n" . $pointy;
+ }
+ elsif($i == (length($_[0]) - 1) ) {
+ # Already has a newline at end.
+ $errmsg .= $pointy;
+ }
+ else {
+ # don't bother with the pointy bit, I guess.
+ }
+ Carp::croak( "$errmsg via $target, as used" );
+}
+
+1;
diff --git a/lib/Locale/Maketext.pod b/lib/Locale/Maketext.pod
new file mode 100644
index 0000000..564e5af
--- /dev/null
+++ b/lib/Locale/Maketext.pod
@@ -0,0 +1,1424 @@
+
+# Time-stamp: "2004-01-11 18:35:34 AST"
+
+=head1 NAME
+
+Locale::Maketext - framework for localization
+
+=head1 SYNOPSIS
+
+ package MyProgram;
+ use strict;
+ use MyProgram::L10N;
+ # ...which inherits from Locale::Maketext
+ my $lh = MyProgram::L10N->get_handle() || die "What language?";
+ ...
+ # And then any messages your program emits, like:
+ warn $lh->maketext( "Can't open file [_1]: [_2]\n", $f, $! );
+ ...
+
+=head1 DESCRIPTION
+
+It is a common feature of applications (whether run directly,
+or via the Web) for them to be "localized" -- i.e., for them
+to a present an English interface to an English-speaker, a German
+interface to a German-speaker, and so on for all languages it's
+programmed with. Locale::Maketext
+is a framework for software localization; it provides you with the
+tools for organizing and accessing the bits of text and text-processing
+code that you need for producing localized applications.
+
+In order to make sense of Maketext and how all its
+components fit together, you should probably
+go read L, and
+I read the following documentation.
+
+You may also want to read over the source for C
+and its constituent modules -- they are a complete (if small)
+example application that uses Maketext.
+
+=head1 QUICK OVERVIEW
+
+The basic design of Locale::Maketext is object-oriented, and
+Locale::Maketext is an abstract base class, from which you
+derive a "project class".
+The project class (with a name like "TkBocciBall::Localize",
+which you then use in your module) is in turn the base class
+for all the "language classes" for your project
+(with names "TkBocciBall::Localize::it",
+"TkBocciBall::Localize::en",
+"TkBocciBall::Localize::fr", etc.).
+
+A language class is
+a class containing a lexicon of phrases as class data,
+and possibly also some methods that are of use in interpreting
+phrases in the lexicon, or otherwise dealing with text in that
+language.
+
+An object belonging to a language class is called a "language
+handle"; it's typically a flyweight object.
+
+The normal course of action is to call:
+
+ use TkBocciBall::Localize; # the localization project class
+ $lh = TkBocciBall::Localize->get_handle();
+ # Depending on the user's locale, etc., this will
+ # make a language handle from among the classes available,
+ # and any defaults that you declare.
+ die "Couldn't make a language handle??" unless $lh;
+
+From then on, you use the C function to access
+entries in whatever lexicon(s) belong to the language handle
+you got. So, this:
+
+ print $lh->maketext("You won!"), "\n";
+
+...emits the right text for this language. If the object
+in C<$lh> belongs to class "TkBocciBall::Localize::fr" and
+%TkBocciBall::Localize::fr::Lexicon contains C<("You won!"
+=E "Tu as gagnE!")>, then the above
+code happily tells the user "Tu as gagnE!".
+
+=head1 METHODS
+
+Locale::Maketext offers a variety of methods, which fall
+into three categories:
+
+=over
+
+=item *
+
+Methods to do with constructing language handles.
+
+=item *
+
+C and other methods to do with accessing %Lexicon data
+for a given language handle.
+
+=item *
+
+Methods that you may find it handy to use, from routines of
+yours that you put in %Lexicon entries.
+
+=back
+
+These are covered in the following section.
+
+=head2 Construction Methods
+
+These are to do with constructing a language handle:
+
+=over
+
+=item *
+
+$lh = YourProjClass->get_handle( ...langtags... ) || die "lg-handle?";
+
+This tries loading classes based on the language-tags you give (like
+C<("en-US", "sk", "kon", "es-MX", "ja", "i-klingon")>, and for the first class
+that succeeds, returns YourProjClass::I->new().
+
+If it runs thru the entire given list of language-tags, and finds no classes
+for those exact terms, it then tries "superordinate" language classes.
+So if no "en-US" class (i.e., YourProjClass::en_us)
+was found, nor classes for anything else in that list, we then try
+its superordinate, "en" (i.e., YourProjClass::en), and so on thru
+the other language-tags in the given list: "es".
+(The other language-tags in our example list:
+happen to have no superordinates.)
+
+If none of those language-tags leads to loadable classes, we then
+try classes derived from YourProjClass->fallback_languages() and
+then if nothing comes of that, we use classes named by
+YourProjClass->fallback_language_classes(). Then in the (probably
+quite unlikely) event that that fails, we just return undef.
+
+=item *
+
+$lh = YourProjClass->get_handleB<()> || die "lg-handle?";
+
+When C is called with an empty parameter list, magic happens:
+
+If C senses that it's running in program that was
+invoked as a CGI, then it tries to get language-tags out of the
+environment variable "HTTP_ACCEPT_LANGUAGE", and it pretends that
+those were the languages passed as parameters to C.
+
+Otherwise (i.e., if not a CGI), this tries various OS-specific ways
+to get the language-tags for the current locale/language, and then
+pretends that those were the value(s) passed to C.
+
+Currently this OS-specific stuff consists of looking in the environment
+variables "LANG" and "LANGUAGE"; and on MSWin machines (where those
+variables are typically unused), this also tries using
+the module Win32::Locale to get a language-tag for whatever language/locale
+is currently selected in the "Regional Settings" (or "International"?)
+Control Panel. I welcome further
+suggestions for making this do the Right Thing under other operating
+systems that support localization.
+
+If you're using localization in an application that keeps a configuration
+file, you might consider something like this in your project class:
+
+ sub get_handle_via_config {
+ my $class = $_[0];
+ my $chosen_language = $Config_settings{'language'};
+ my $lh;
+ if($chosen_language) {
+ $lh = $class->get_handle($chosen_language)
+ || die "No language handle for \"$chosen_language\""
+ . " or the like";
+ } else {
+ # Config file missing, maybe?
+ $lh = $class->get_handle()
+ || die "Can't get a language handle";
+ }
+ return $lh;
+ }
+
+=item *
+
+$lh = YourProjClass::langname->new();
+
+This constructs a language handle. You usually B call this
+directly, but instead let C find a language class to C