More messing with Encode:

  Extra fields in header to allow multiple names and to record
  other things "compile" knows.
  Re-organise compile to factor out common output routines.

p4raw-id: //depot/perlio@8520

1 files changed, 43 insertions, 37 deletions

diff --git a/ext/Encode/compile b/ext/Encode/compile
index 755b78ca14..b1d68a298b 100755
--- a/ext/Encode/compile
+++ b/ext/Encode/compile
@@ -3,6 +3,8 @@ BEGIN { @INC = '../../lib' };
 use strict;
 use Getopt::Std;
 my @orig_ARGV = @ARGV;
+my $perforce  = '$Id$';
+
 
 sub encode_U
 {
@@ -57,7 +59,7 @@ open(C,">$cname") || die "Cannot open $cname:$!";
 my $dname = $cname;
 $dname =~ s/(\.[^\.]*)?$/.def/;
 
-my ($doC,$doEnc,$doUcm);
+my ($doC,$doEnc,$doUcm,$doPet);
 
 if ($cname =~ /\.(c|xs)$/)
  {
@@ -76,6 +78,7 @@ if ($cname =~ /\.(c|xs)$/)
  !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
  This file was autogenerated by:
  $^X $0 $cname @orig_ARGV
+ (Repository $perforce)
 */
 END
   }
@@ -97,6 +100,10 @@ elsif ($cname =~ /\.ucm$/)
  {
   $doUcm = 1;
  }
+elsif ($cname =~ /\.pet$/)
+ {
+  $doPet = 1;
+ }
 
 my @encfiles;
 if (exists $opt{'f'})
@@ -129,6 +136,7 @@ sub cmp_name
  return $a cmp $b;
 }
 
+
 foreach my $enc (sort cmp_name @encfiles)
  {
   my ($name,$sfx) = $enc =~ /^.*?([\w-]+)\.(enc|ucm)$/;
@@ -137,11 +145,11 @@ foreach my $enc (sort cmp_name @encfiles)
    {
     if ($sfx eq 'enc')
      {
-      compile_enc(\*E,lc($name),\*C);
+      compile_enc(\*E,lc($name));
      }
     else
      {
-      compile_ucm(\*E,lc($name),\*C);
+      compile_ucm(\*E,lc($name));
      }
    }
   else
@@ -152,12 +160,21 @@ foreach my $enc (sort cmp_name @encfiles)
 
 if ($doC)
  {
+  foreach my $name (sort cmp_name keys %encoding)
+   {
+    my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
+    output(\*C,$name.'_utf8',$e2u);
+    output(\*C,'utf8_'.$name,$u2e);
+    push(@{$encoding{$name}},outstring(\*C,$e2u->{Cname}.'_def',$erep));
+   }
   foreach my $enc (sort cmp_name keys %encoding)
    {
+    my ($e2u,$u2e,$rep,$min_el,$max_el,$rsym) = @{$encoding{$enc}};
+    my @info = ($e2u->{Cname},$u2e->{Cname},$rsym,length($rep),$min_el,$max_el);
     my $sym = "${enc}_encoding";
     $sym =~ s/\W+/_/g;
     print C "encode_t $sym = \n";
-    print C " {",join(',',"\"$enc\"",@{$encoding{$enc}}),"};\n\n";
+    print C " {",join(',',@info,"{\"$enc\",(const char *)0}"),"};\n\n";
    }
 
   foreach my $enc (sort cmp_name keys %encoding)
@@ -179,12 +196,29 @@ if ($doC)
   close(D);
   close(H);
  }
+elsif ($doEnc)
+ {
+  foreach my $name (sort cmp_name keys %encoding)
+   {
+    my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
+    output_enc(\*C,$name,$e2u);
+   }
+ }
+elsif ($doUcm)
+ {
+  foreach my $name (sort cmp_name keys %encoding)
+   {
+    my ($e2u,$u2e,$erep,$min_el,$max_el) = @{$encoding{$name}};
+    output_ucm(\*C,$name,$u2e,$erep,$min_el,$max_el);
+   }
+ }
+
 close(C);
 
 
 sub compile_ucm
 {
- my ($fh,$name,$ch) = @_;
+ my ($fh,$name) = @_;
  my $e2u = {};
  my $u2e = {};
  my $cs;
@@ -266,26 +300,12 @@ sub compile_ucm
   {
    die "$nfb entries without fallback, $hfb entries with\n";
   }
- if ($doC)
-  {
-   output($ch,$name.'_utf8',$e2u);
-   output($ch,'utf8_'.$name,$u2e);
-   $encoding{$name} = [$e2u->{Cname},$u2e->{Cname},
-                       outstring($ch,$e2u->{Cname}.'_def',$erep),length($erep)];
-  }
- elsif ($doEnc)
-  {
-   output_enc($ch,$name,$e2u);
-  }
- elsif ($doUcm)
-  {
-   output_ucm($ch,$name,$u2e,$erep,$min_el,$max_el);
-  }
+ $encoding{$name} = [$e2u,$u2e,$erep,$min_el,$max_el];
 }
 
 sub compile_enc
 {
- my ($fh,$name,$ch) = @_;
+ my ($fh,$name) = @_;
  my $e2u = {};
  my $u2e = {};
 
@@ -349,21 +369,7 @@ sub compile_enc
       }
     }
   }
- if ($doC)
-  {
-   output($ch,$name.'_utf8',$e2u);
-   output($ch,'utf8_'.$name,$u2e);
-   $encoding{$name} = [$e2u->{Cname},$u2e->{Cname},
-                       outstring($ch,$e2u->{Cname}.'_def',$rep),length($rep)];
-  }
- elsif ($doEnc)
-  {
-   output_enc($ch,$name,$e2u);
-  }
- elsif ($doUcm)
-  {
-   output_ucm($ch,$name,$u2e,$rep,$min_el,$max_el);
-  }
+ $encoding{$name} = [$e2u,$u2e,$rep,$min_el,$max_el];
 }
 
 sub enter
@@ -569,7 +575,7 @@ sub output_ucm_page
 sub output_ucm
 {
  my ($fh,$name,$a,$rep,$min_el,$max_el) = @_;
- print $fh "# Written by $0 @orig_ARGV\n" unless $opt{'q'};
+ print $fh "# Written $perforce\n# $0 @orig_ARGV\n" unless $opt{'q'};
  print $fh "<code_set_name> \"$name\"\n";
  if (defined $min_el)
   {