From: Jarkko Hietaniemi Date: Wed, 20 Jun 2001 18:45:00 +0000 (+0000) Subject: Upgrade to Locale::Maketext 1.02, from Sean Burke. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ff5ad48a406d02420ef1036954fc4b1323a7f781;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Locale::Maketext 1.02, from Sean Burke. p4raw-id: //depot/perl@10762 --- diff --git a/MANIFEST b/MANIFEST index 0ca611b..e41baf8 100644 --- a/MANIFEST +++ b/MANIFEST @@ -995,7 +995,9 @@ lib/Locale/Currency.pm Locale::Codes 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 diff --git a/lib/Locale/Maketext.pm b/lib/Locale/Maketext.pm index a39383f..f8e82eb 100644 --- a/lib/Locale/Maketext.pm +++ b/lib/Locale/Maketext.pm @@ -1,5 +1,5 @@ -# Time-stamp: "2001-05-25 07:49:06 MDT" +# Time-stamp: "2000-11-14 22:27:26 MST" require 5; package Locale::Maketext; @@ -14,7 +14,7 @@ use I18N::LangTags 0.21 (); BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } } # define the constant 'DEBUG' at compile-time -$VERSION = "1.01"; +$VERSION = "1.02"; @ISA = (); $MATCH_SUPERS = 1; @@ -286,12 +286,15 @@ sub get_handle { # This is a constructor and, yes, it CAN FAIL. # 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! @@ -349,11 +352,11 @@ sub _compile { | ~. # ~[, ~], ~~, ~other | - \x5B # [ + \[ # [ presumably opening a group | - \x5D # ] + \] # ] presumably closing a group | - ~ # terminal ~? + ~ # terminal ~ ? | $ )>xgs @@ -379,7 +382,13 @@ sub _compile { 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"; @@ -411,14 +420,24 @@ sub _compile { #$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 @@ -461,7 +480,13 @@ sub _compile { } 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{', }; @@ -494,9 +519,13 @@ sub _compile { } 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] .= '~,'; } @@ -627,7 +656,8 @@ sub _lex_refs { # report the lexicon references for this handle's class 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}++; @@ -643,4 +673,3 @@ sub clear_isa_scan { %isa_scan = (); return; } # end on a note of simplicity! ########################################################################### 1; - diff --git a/lib/Locale/Maketext.pod b/lib/Locale/Maketext.pod index d32f9d5..ef5e66e 100644 --- a/lib/Locale/Maketext.pod +++ b/lib/Locale/Maketext.pod @@ -1,5 +1,5 @@ -# Time-stamp: "2001-05-25 07:50:08 MDT" +# Time-stamp: "2001-06-20 02:02:33 MDT" =head1 NAME @@ -110,9 +110,7 @@ These are to do with constructing a language handle: =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 @@ -133,9 +131,7 @@ 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?"; +=item $lh = YourProjClass->get_handleB<()> || die "lg-handle?"; When C is called with an empty parameter list, magic happens: @@ -731,6 +727,13 @@ then that group is interpreted like this: =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" or "_-I", then that group is interpreted as just the interpolation of all its items: diff --git a/lib/Locale/Maketext.t b/lib/Locale/Maketext.t deleted file mode 100644 index 743d8ee..0000000 --- a/lib/Locale/Maketext.t +++ /dev/null @@ -1,37 +0,0 @@ -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! diff --git a/lib/Locale/Maketext/ChangeLog b/lib/Locale/Maketext/ChangeLog new file mode 100644 index 0000000..e85ed6e --- /dev/null +++ b/lib/Locale/Maketext/ChangeLog @@ -0,0 +1,21 @@ +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. diff --git a/lib/Locale/Maketext/README b/lib/Locale/Maketext/README new file mode 100644 index 0000000..dd96611 --- /dev/null +++ b/lib/Locale/Maketext/README @@ -0,0 +1,70 @@ +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 + to find a CPAN site near you. + + +COPYRIGHT + +Copyright 1999-2001, 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/TPJ13.pod b/lib/Locale/Maketext/TPJ13.pod index db22478..5c2f28c 100644 --- a/lib/Locale/Maketext/TPJ13.pod +++ b/lib/Locale/Maketext/TPJ13.pod @@ -677,7 +677,7 @@ quantification is not as complicated an operation. =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 diff --git a/lib/Locale/Maketext/test.pl b/lib/Locale/Maketext/test.pl new file mode 100644 index 0000000..1a29da3 --- /dev/null +++ b/lib/Locale/Maketext/test.pl @@ -0,0 +1,61 @@ +# 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!