This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Unicode::UCD: Cope with 6.1 Name_Alias changes
authorKarl Williamson <public@khwilliamson.com>
Thu, 2 Feb 2012 02:32:24 +0000 (19:32 -0700)
committerKarl Williamson <public@khwilliamson.com>
Sat, 4 Feb 2012 22:14:56 +0000 (15:14 -0700)
The format of this property in Unicode 6.1 is changing, so that the
previous algorithm for separating it out from Name.pl no longer works.

lib/Unicode/UCD.pm
lib/Unicode/UCD.t

index 0bc6d45..074284f 100644 (file)
@@ -2634,16 +2634,35 @@ RETRY:
             my %names;
             $names{'LIST'} = "";
             my $original = do "unicore/Name.pl";
-            my $previous_hex_code_point = "";
             my $algorithm_names = \@algorithmic_named_code_points;
 
+            # We need to remove the names from it that are aliases.  For that
+            # we need to also read in that table.  Create a hash with the keys
+            # being the code points, and the values being a list of the
+            # aliases for the code point key.
+            my ($aliases_code_points, $aliases_maps, undef, undef) =
+                                                &prop_invmap('Name_Alias');
+            my %aliases;
+            for (my $i = 0; $i < @$aliases_code_points; $i++) {
+                my $code_point = $aliases_code_points->[$i];
+                $aliases{$code_point} = $aliases_maps->[$i];
+
+                # If not already a list, make it into one, so that later we
+                # can treat things uniformly
+                if (! ref $aliases{$code_point}) {
+                    $aliases{$code_point} = [ $aliases{$code_point} ];
+                }
+
+                # Remove the alias type from the entry, retaining just the
+                # name.
+                map { s/:.*// } @{$aliases{$code_point}};
+            }
+
             # We hold off on adding the next entry to the list until we know,
             # that the next line isn't for the same code point.  We only
             # output the final line.  That one is the original Name property
             # value.  The others are the Name_Alias corrections, which are
             # listed first in the file.
-            my $staging = "";
-
             my $i = 0;
             foreach my $line (split "\n", $original) {
                 my ($hex_code_point, $name) = split "\t", $line;
@@ -2659,43 +2678,32 @@ RETRY:
                 next if $code_point <= 0x9F
                         && ($code_point <= 0x1F || $code_point >= 0x7F);
 
-                # Output the last iteration's result, but only output the
-                # final name if a code point has more than one.
-                $names{'LIST'} .= $staging
-                                if $hex_code_point ne $previous_hex_code_point;
+                # If this is a name_alias, it isn't a name
+                next if grep { $_ eq $name } @{$aliases{$code_point}};
 
                 # If we are beyond where one of the special lines needs to
                 # be inserted ...
-                if ($i < @$algorithm_names
+                while ($i < @$algorithm_names
                     && $code_point > $algorithm_names->[$i]->{'low'})
                 {
 
                     # ... then insert it, ahead of what we were about to
                     # output
-                    $staging = sprintf "%x\t%x\t%s\n",
+                    $names{'LIST'} .= sprintf "%x\t%x\t%s\n",
                                             $algorithm_names->[$i]->{'low'},
                                             $algorithm_names->[$i]->{'high'},
                                             $algorithm_names->[$i]->{'name'};
 
-                    # And pretend that what we last saw was the final code
-                    # point of the inserted range.
-                    $previous_hex_code_point = sprintf "%04X",
-                                            $algorithm_names->[$i]->{'high'};
-
                     # Done with this range.
                     $i++;
 
-                    # Except we actually need to output the inserted line.
-                    redo;
+                    # We loop until all special lines that precede the next
+                    # regular one are output.
                 }
 
-                # Normal name.
-                $staging = sprintf "%x\t\t%s\n", $code_point, $name;
-                $previous_hex_code_point = $hex_code_point;
-            }
-
-            # Add the name from the final iteration
-            $names{'LIST'} .= $staging;
+                # Here, is a normal name.
+                $names{'LIST'} .= sprintf "%x\t\t%s\n", $code_point, $name;
+            } # End of loop through all the names
 
             $names{'TYPE'} = "ToNa";
             $utf8::SwashInfo{ToNa}{'missing'} = "";
index e74b29e..b92dd51 100644 (file)
@@ -1521,10 +1521,37 @@ foreach my $prop (keys %props) {
             if (ref $invmap_ref->[$i]
                 && ($format eq 'd' || $format =~ /^ . l /x))
             {
-                # The stringification depends on the format.  At the time of
-                # this writing, all 'sl' formats are space separated.
+                # The stringification depends on the format.
                 if ($format eq 'sl') {
-                    $invmap_ref->[$i] = join " ", @{$invmap_ref->[$i]};
+
+                    # At the time of this writing, there are two types of 'sl'
+                    # format  One, in Name_Alias, has multiple separate entries
+                    # for each code point; the other, in Script_Extension, is space
+                    # separated.  Assume the latter for non-Name_Alias.
+                    if ($full_name ne 'Name_Alias') {
+                        $invmap_ref->[$i] = join " ", @{$invmap_ref->[$i]};
+                    }
+                    else {
+                        # For Name_Alias, we emulate the file.  Entries with
+                        # just one value don't need any changes, but we
+                        # convert the list entries into a series of lines for
+                        # the file, starting with the first name.  The
+                        # succeeding entries are on separate lines, with the
+                        # code point repeated for each one and then two tabs,
+                        # then the value.  Code at the end of the loop will
+                        # set up the first line with its code point and two
+                        # tabs before the value, just as it does for every
+                        # other property; thus the special handling of the
+                        # first line.
+                        if (ref $invmap_ref->[$i]) {
+                            my $hex_cp = sprintf("%04X", $invlist_ref->[$i]);
+                            my $concatenated = $invmap_ref->[$i][0];
+                            for (my $j = 1; $j < @{$invmap_ref->[$i]}; $j++) {
+                                $concatenated .= "\n$hex_cp\t\t" . $invmap_ref->[$i][$j];
+                            }
+                            $invmap_ref->[$i] = $concatenated;
+                        }
+                    }
                 }
                 elsif ($format =~ / ^ cl e? $/x) {
 
@@ -1675,7 +1702,9 @@ foreach my $prop (keys %props) {
 
         # Handle the Name property similar to the above.  But the file is
         # sufficiently different that it is more convenient to make a special
-        # case for it.
+        # case for it.  It is a combination of the Name, Unicode1_Name, and
+        # Name_Alias properties, and named sequences.  We need to remove all
+        # but the Name in order to do the comparison.
 
         if ($missing ne "") {
             fail("prop_invmap('$mod_prop')");
@@ -1690,30 +1719,40 @@ foreach my $prop (keys %props) {
         $official =~ s/ ^ [^\t]+ \  .*? \n //xmg;
 
         # And get rid of the controls.  These are named in the file, but
-        # shouldn't be in the property.
+        # shouldn't be in the property.  This gets rid of the two ranges in
+        # one fell swoop, and also all the Unicode1_Name values that may not
+        # be in Name_Alias.
         $official =~ s/ 00000 \t .* 0001F .*? \n//xs;
         $official =~ s/ 0007F \t .* 0009F .*? \n//xs;
 
-        # This is slow; it gets rid of the aliases.  We look for lines that
-        # are for the same code point as the previous line.  The previous line
-        # will be a name_alias; and the current line will be the name.  Get
-        # rid of the name_alias line.  This won't work if there are multiple
-        # aliases for a given name.
-        my @temp_names = split "\n", $official;
-        my $previous_cp = "";
-        for (my $i = 0; $i < @temp_names - 1; $i++) {
-            $temp_names[$i] =~ /^ (.*)? \t /x;
-            my $current_cp = $1;
-            if ($current_cp eq $previous_cp) {
-                splice @temp_names, $i - 1, 1;
-                redo;
-            }
-            else {
-                $previous_cp = $current_cp;
+        # And remove the aliases.  We read in the Name_Alias property, and go
+        # through them one by one.
+        my ($aliases_code_points, $aliases_maps, undef, undef)
+                                                = &prop_invmap('Name_Alias');
+        for (my $i = 0; $i < @$aliases_code_points; $i++) {
+            my $code_point = $aliases_code_points->[$i];
+
+            # Already removed these above.
+            next if $code_point <= 0x1F
+                    || ($code_point >= 0x7F && $code_point <= 0x9F);
+
+            my $hex_code_point = sprintf "%05X", $code_point;
+
+            # Convert to a list if not already to make the following loop
+            # control uniform.
+            $aliases_maps->[$i] = [ $aliases_maps->[$i] ]
+                                                if ! ref $aliases_maps->[$i];
+
+            # Remove each alias for this code point from the file
+            foreach my $alias (@{$aliases_maps->[$i]}) {
+
+                # Remove the alias type from the entry, retaining just the name.
+                $alias =~ s/:.*//;
+
+                $alias = quotemeta($alias);
+                $official =~ s/$hex_code_point \t $alias \n //x;
             }
         }
-        $official = join "\n", @temp_names;
-        undef @temp_names;
         chomp $official;
 
         # Here have adjusted the file.  We also have to adjust the returned