lib/Locale/Language.pm Locale::Codes
lib/Locale/Maketext.pm Locale::Maketext
lib/Locale/Maketext.pod Locale::Maketext documentation
-lib/Locale/Maketext.t See if Locale::Maketext works
+lib/Locale/Maketext/ChangeLog Locale::Maketext
+lib/Locale/Maketext/README Locale::Maketext
+lib/Locale/Maketext/test.pl See if Locale::Maketext works
lib/Locale/Maketext/TPJ13.pod Locale::Maketext documentation article
lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package
lib/Math/BigInt.pm An arbitrary precision integer arithmetic package
-# Time-stamp: "2001-05-25 07:49:06 MDT"
+# Time-stamp: "2000-11-14 22:27:26 MST"
require 5;
package Locale::Maketext;
BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } }
# define the constant 'DEBUG' at compile-time
-$VERSION = "1.01";
+$VERSION = "1.02";
@ISA = ();
$MATCH_SUPERS = 1;
# if it's a locale ID, try converting to a lg tag (untainted),
# otherwise nix it.
- push @languages, map &I18N::LangTags::super_languages($_), @languages
+ push @languages, map I18N::LangTags::super_languages($_), @languages
if $MATCH_SUPERS;
- @languages = map { $_, &I18N::LangTags::alternate_language_tags($_) }
+ @languages = map { $_, I18N::LangTags::alternate_language_tags($_) }
@languages; # catch alternation
+ push @languages, I18N::LangTags::panic_languages(@languages)
+ if defined &I18N::LangTags::panic_languages;
+
push @languages, $base_class->fallback_languages;
# You are free to override fallback_languages to return empty-list!
|
~. # ~[, ~], ~~, ~other
|
- \x5B # [
+ \[ # [ presumably opening a group
|
- \x5D # ]
+ \] # ] presumably closing a group
|
- ~ # terminal ~?
+ ~ # terminal ~ ?
|
$
)>xgs
if(length $c[-1]) {
# Now actually processing the preceding literal
$big_pile .= $c[-1];
- if($USE_LITERALS and $c[-1] !~ m<[^\x20-\x7E]>s) {
+ 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] =~ s/\s+$//s;
($m,@params) = split(",", $c[-1], -1); # was /\s*,\s*/
- foreach($m, @params) { tr/\x7F/,/ }
- # A bit of a hack -- we've turned "~,"'s into \x7F's, so turn
- # 'em into real commas here.
+ # 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
} elsif($p =~ m<^_(-?\d+)$>s) {
# _3 meaning $_[3]
$code[-1] .= '$_[' . (0 + $1) . '], ';
- } elsif($USE_LITERALS and $p !~ m<[^\x20-\x7E]>s) {
+ } 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{', };
} elsif($1 eq '~,') { # "~,"
if($in_group) {
- $c[-1] .= "\x7F";
- # This is a hack, based on the assumption that no-one will actually
- # want a \x7f inside a bracket group. Let's hope that's it's true.
+ # 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] .= '~,';
}
scalar(keys %{$class . '::Lexicon'}), " entries\n" if DEBUG;
}
- # Implements depth(height?)-first recursive searching of superclasses
+ # Implements depth(height?)-first recursive searching of superclasses.
+ # In hindsight, I suppose I could have just used Class::ISA!
foreach my $superclass (@{$class . "::ISA"}) {
print " Super-class search into $superclass\n" if DEBUG;
next if $seen_r->{$superclass}++;
###########################################################################
1;
-
-# Time-stamp: "2001-05-25 07:50:08 MDT"
+# Time-stamp: "2001-06-20 02:02:33 MDT"
=head1 NAME
=over
-=item *
-
-$lh = YourProjClass->get_handle( ...langtags... ) || die "lg-handle?";
+=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
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?";
+=item $lh = YourProjClass->get_handleB<()> || die "lg-handle?";
When C<get_handle> is called with an empty parameter list, magic happens:
=item *
+If the first item in a bracket group is "*", it's taken as shorthand
+for the so commonly called "quant" method. Similarly, if the first
+item in a bracket group is "#", it's taken to be shorthand for
+"numf".
+
+=item *
+
If the first item in a bracket group is empty-string, or "_*"
or "_I<digits>" or "_-I<digits>", then that group is interpreted
as just the interpolation of all its items:
+++ /dev/null
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
-}
-
-BEGIN { $| = 1; print "1..3\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Locale::Maketext 1.01;
-print "# Perl v$], Locale::Maketext v$Locale::Maketext::VERSION\n";
-$loaded = 1;
-print "ok 1\n";
-{
- package Woozle;
- @ISA = ('Locale::Maketext');
- sub dubbil { return $_[1] * 2 }
-}
-{
- package Woozle::elx;
- @ISA = ('Woozle');
- %Lexicon = (
- 'd2' => 'hum [dubbil,_1]',
- );
-}
-
-$lh = Woozle->get_handle('elx');
-if($lh) {
- print "ok 2\n";
- my $x = $lh->maketext('d2', 7);
- if($x eq "hum 14") {
- print "ok 3\n";
- } else {
- print "not ok 3\n (got \"$x\")\n";
- }
-} else {
- print "not ok 2\n";
-}
-#Shazam!
--- /dev/null
+Revision history for Perl suite Locale::Maketext
+ Time-stamp: "2001-06-20 02:14:35 MDT"
+
+2001-06-20 Sean M. Burke sburke@cpan.org
+ * Release 1.02: EBCDIC-compatability 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.
--- /dev/null
+README for Locale::Maketext
+ Time-stamp: "2001-05-25 08:15:55 MDT"
+
+ 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).
+
+This is a complete rewrite from the basically undocumented 0.x
+versions.
+
+
+
+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.
+
+
+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
+<http://www.perl.com/CPAN/> to find a CPAN site near you.
+
+
+COPYRIGHT
+
+Copyright 1999-2001, Sean M. Burke <sburke@cpan.org>, 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 <sburke@cpan.org>
=head2 The Devil in the Details
There's plenty more to Maketext than described above -- for example,
-there's the details of how language tags ("en-US", "x-cree", "fi",
+there's the details of how language tags ("en-US", "i-pwn", "fi",
etc.) or locale IDs ("en_US") interact with actual module naming
("BogoQuery/Locale/en_us.pm"), and what magic can ensue; there's the
details of how to record (and possibly negotiate) what character
--- /dev/null
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+# Time-stamp: "2001-06-20 02:12:53 MDT"
+######################### We start with some black magic to print on failure.
+
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..5\n"; }
+END {print "fail 1\n" unless $loaded;}
+use Locale::Maketext 1.01;
+print "# Perl v$], Locale::Maketext v$Locale::Maketext::VERSION\n";
+$loaded = 1;
+print "ok 1\n";
+{
+ package Woozle;
+ @ISA = ('Locale::Maketext');
+ sub dubbil { return $_[1] * 2 }
+ sub numerate { return $_[2] . 'en' }
+}
+{
+ package Woozle::elx;
+ @ISA = ('Woozle');
+ %Lexicon = (
+ 'd2' => 'hum [dubbil,_1]',
+ 'd3' => 'hoo [quant,_1,zaz]',
+ 'd4' => 'hoo [*,_1,zaz]',
+ );
+}
+
+$lh = Woozle->get_handle('elx');
+if($lh) {
+ print "ok 2\n";
+
+ my $x;
+
+ $x = $lh->maketext('d2', 7);
+ if($x eq "hum 14") {
+ print "ok 3\n";
+ } else {
+ print "fail 3 # (got \"$x\")\n";
+ }
+
+ $x = $lh->maketext('d3', 7);
+ if($x eq "hoo 7 zazen") {
+ print "ok 4\n";
+ } else {
+ print "fail 4 # (got \"$x\")\n";
+ }
+
+ $x = $lh->maketext('d4', 7);
+ if($x eq "hoo 7 zazen") {
+ print "ok 5\n";
+ } else {
+ print "fail 5 # (got \"$x\")\n";
+ }
+
+
+} else {
+ print "fail 2\n";
+}
+#Shazam!
https://perl5.git.perl.org / perl5.git / commitdiff