Upgrade to Locale::Maketext 1.02, from Sean Burke.

p4raw-id: //depot/perl@10762

7 files changed, 209 insertions, 62 deletions

diff --git a/lib/Locale/Maketext.pm b/lib/Locale/Maketext.pm
index a39383fc30..f8e82ebf35 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 d32f9d5901..ef5e66ebbc 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<get_handle> 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<digits>" or "_-I<digits>", 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 743d8eecbd..0000000000
--- 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 0000000000..e85ed6e0c3
--- /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 0000000000..dd966119d4
--- /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
+<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>
diff --git a/lib/Locale/Maketext/TPJ13.pod b/lib/Locale/Maketext/TPJ13.pod
index db22478215..5c2f28cab4 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 0000000000..1a29da359b
--- /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!