+## !!!!!!!!!!!!!! IF YOU MODIFY THIS FILE !!!!!!!!!!!!!!!!!!!!!!!!!
+## Any files created or read by this program should be listed in 'mktables.lst'
+
#!/usr/bin/perl -w
require 5.008; # Needs pack "U". Probably safest to run on 5.8.x
use strict;
use Carp;
+use File::Spec;
##
## mktables -- create the runtime Perl Unicode files (lib/unicore/**/*.pl)
## from the Unicode database files (lib/unicore/*.txt).
##
-mkdir("lib", 0755);
-mkdir("lib/gc_sc", 0755);
-mkdir("To", 0755);
+## "Fuzzy" means this section in Unicode TR18:
+##
+## The recommended names for UCD properties and property values are in
+## PropertyAliases.txt [Prop] and PropertyValueAliases.txt
+## [PropValue]. There are both abbreviated names and longer, more
+## descriptive names. It is strongly recommended that both names be
+## recognized, and that loose matching of property names be used,
+## whereby the case distinctions, whitespace, hyphens, and underbar
+## are ignored.
## Base names already used in lib/gc_sc (for avoiding 8.3 conflicts)
my %BaseNames;
-
##
## Process any args.
##
my $Verbose = 0;
my $MakeTestScript = 0;
+my $AlwaysWrite = 0;
+my $UseDir = "";
+my $FileList = "$0.lst";
+my $MakeList = 0;
while (@ARGV)
{
$Verbose = 1;
} elsif ($arg eq '-q') {
$Verbose = 0;
+ } elsif ($arg eq '-w') {
+ $AlwaysWrite = 1; # update the files even if they havent changed
+ $FileList = "";
+ } elsif ($arg eq '-check') {
+ my $this = shift @ARGV;
+ my $ok = shift @ARGV;
+ if ($this ne $ok) {
+ print "Skipping as check params are not the same.\n";
+ exit(0);
+ }
} elsif ($arg eq '-maketest') {
$MakeTestScript = 1;
+ } elsif ($arg eq '-makelist') {
+ $MakeList = 1;
+ } elsif ($arg eq '-C' && defined ($UseDir = shift)) {
+ -d $UseDir or die "Unknown directory '$UseDir'";
+ } elsif ($arg eq '-L' && defined ($FileList = shift)) {
+ -e $FileList or die "Filelist '$FileList' doesn't appear to exist!";
} else {
- die "usage: $0 [-v|-q] [-maketest]";
+ die "usage: $0 [-v|-q|-w|-C dir|-L filelist] [-maketest] [-makelist]\n",
+ " -v : Verbose Mode\n",
+ " -q : Quiet Mode\n",
+ " -w : Write files regardless\n",
+ " -maketest : Make test script\n",
+ " -makelist : Rewrite the file list based on current setup\n",
+ " -L filelist : Use this file list, (defaults to $0)\n",
+ " -C dir : Change to this directory before proceeding\n",
+ " -check A B : Executes only if A and B are the same\n";
+ }
+}
+
+if ($FileList) {
+ print "Reading file list '$FileList'\n"
+ if $Verbose;
+ open my $fh,"<",$FileList or die "Failed to read '$FileList':$!";
+ my @input;
+ my @output;
+ for my $list ( \@input, \@output ) {
+ while (<$fh>) {
+ s/^ \s+ | \s+ $//xg;
+ next if /^ \s* (?: \# .* )? $/x;
+ last if /^ =+ $/x;
+ my ( $file ) = split /\t/, $_;
+ push @$list, $file;
+ }
+ my %dupe;
+ @$list = grep !$dupe{ $_ }++, @$list;
+ }
+ close $fh;
+ die "No input or output files in '$FileList'!"
+ if !@input or !@output;
+ if ( $MakeList ) {
+ foreach my $file (@output) {
+ unlink $file;
+ }
+ }
+ if ( $Verbose ) {
+ print "Expecting ".scalar( @input )." input files. ",
+ "Checking ".scalar( @output )." output files.\n";
+ }
+ # we set maxtime to be the youngest input file, including $0 itself.
+ my $maxtime = -M $0; # do this before the chdir!
+ if ($UseDir) {
+ chdir $UseDir or die "Failed to chdir to '$UseDir':$!";
+ }
+ foreach my $in (@input) {
+ my $time = -M $in;
+ die "Missing input file '$in'" unless defined $time;
+ $maxtime = $time if $maxtime < $time;
+ }
+
+ # now we check to see if any output files are older than maxtime, if
+ # they are we need to continue on, otherwise we can presumably bail.
+ my $ok = 1;
+ foreach my $out (@output) {
+ if ( ! -e $out ) {
+ print "'$out' is missing.\n"
+ if $Verbose;
+ $ok = 0;
+ last;
+ }
+ if ( -M $out > $maxtime ) {
+ print "'$out' is too old.\n"
+ if $Verbose;
+ $ok = 0;
+ last;
+ }
+ }
+ if ($ok) {
+ print "Files seem to be ok, not bothering to rebuild.\n";
+ exit(0);
+ }
+ print "Must rebuild tables.\n"
+ if $Verbose;
+} else {
+ if ($Verbose) {
+ print "Not checking filelist.\n";
+ }
+ if ($UseDir) {
+ chdir $UseDir or die "Failed to chdir to '$UseDir':$!";
}
}
+foreach my $lib ('To', 'lib',
+ map {File::Spec->catdir("lib",$_)}
+ qw(gc_sc dt bc hst ea jt lb nt ccc)) {
+ next if -d $lib;
+ mkdir $lib, 0755 or die "mkdir '$lib': $!";
+}
+
my $LastUnicodeCodepoint = 0x10FFFF; # As of Unicode 3.1.1.
my $HEADER=<<"EOF";
EOF
+sub force_unlink {
+ my $filename = shift;
+ return unless -e $filename;
+ return if CORE::unlink($filename);
+ # We might need write permission
+ chmod 0777, $filename;
+ CORE::unlink($filename) or die "Couldn't unlink $filename: $!\n";
+}
##
## Given a filename and a reference to an array of lines,
## write the lines to the file only if the contents have not changed.
+## Filename can be given as an arrayref of directory names
##
sub WriteIfChanged($\@)
{
my $file = shift;
my $lines = shift;
+ $file = File::Spec->catfile(@$file) if ref $file;
+
my $TextToWrite = join '', @$lines;
if (open IN, $file) {
local($/) = undef;
close IN;
if ($PreviousText eq $TextToWrite) {
print "$file unchanged.\n" if $Verbose;
- return;
+ return unless $AlwaysWrite;
}
}
+ force_unlink ($file);
if (not open OUT, ">$file") {
die "$0: can't open $file for output: $!\n";
}
{
##
## Most of the work with aliases doesn't occur here,
- ## but rather in utf8_heavy.pl, which uses utf8_pva.pl,
- ## which contains just this function. However, this one
- ##
- ## -- japhy (2004/04/13)
+ ## but rather in utf8_heavy.pl, which uses PVA.pl,
+
+ # Placate the warnings about used only once. (They are used again, but
+ # via a typeglob lookup)
+ %utf8::PropertyAlias = ();
+ %utf8::PA_reverse = ();
+ %utf8::PropValueAlias = ();
+ %utf8::PVA_reverse = ();
+ %utf8::PVA_abbr_map = ();
open PA, "< PropertyAliases.txt"
or confess "Can't open PropertyAliases.txt: $!";
next if $abbrev eq "n/a";
$PropertyAlias{$abbrev} = $name;
$PA_reverse{$name} = $abbrev;
+
+ # The %utf8::... versions use japhy's code originally from utf8_pva.pl
+ # However, it's moved here so that we build the tables at runtime.
+ tr/ _-//d for $abbrev, $name;
+ $utf8::PropertyAlias{lc $abbrev} = $name;
+ $utf8::PA_reverse{lc $name} = $abbrev;
}
close PA;
$PropValueAlias{$prop}{$data[0]} = $data[1];
$PVA_reverse{$prop}{$data[1]} = $data[0];
}
+
+ shift @data if $prop eq 'ccc';
+ next if $data[0] eq "n/a";
+
+ $data[1] =~ tr/ _-//d;
+ $utf8::PropValueAlias{$prop}{lc $data[0]} = $data[1];
+ $utf8::PVA_reverse{$prop}{lc $data[1]} = $data[0];
+
+ my $abbr_class = ($prop eq 'gc' or $prop eq 'sc') ? 'gc_sc' : $prop;
+ $utf8::PVA_abbr_map{$abbr_class}{lc $data[0]} = $data[0];
}
close PVA;
+
+ # backwards compatibility for L& -> LC
+ $utf8::PropValueAlias{gc}{'l&'} = $utf8::PropValueAlias{gc}{lc};
+ $utf8::PVA_abbr_map{gc_sc}{'l&'} = $utf8::PVA_abbr_map{gc_sc}{lc};
+
}
return $Table;
}
-##
-## Returns true if the Table has no code points
-##
-sub Table::IsEmpty
-{
- my $Table = shift; #self
- return not @$Table;
-}
-
-##
-## Returns true if the Table has code points
-##
-sub Table::NotEmpty
-{
- my $Table = shift; #self
- return @$Table;
-}
##
## Returns the maximum code point currently in the table.
##
sub Table::Max
{
- my $Table = shift; #self
- confess "oops" if $Table->IsEmpty; ## must have code points to have a max
- return $Table->[-1]->[RANGE_END];
+ my $last = $_[0]->[-1]; ## last code point
+ confess "oops" unless $last; ## must have code points to have a max
+ return $last->[RANGE_END];
}
##
## Given a new code point, make the last range of the Table extend to
## include the new (and all intervening) code points.
##
+## Takes the time to make sure that the extension is valid.
+##
sub Table::Extend
{
my $Table = shift; #self
confess "oops ($codepoint <= $PrevMax)" if $codepoint <= $PrevMax;
- $Table->[-1]->[RANGE_END] = $codepoint;
+ $Table->ExtendNoCheck($codepoint);
+}
+
+
+##
+## Given a new code point, make the last range of the Table extend to
+## include the new (and all intervening) code points.
+##
+## Does NOT check that the extension is valid. Assumes that the caller
+## has already made this check.
+##
+sub Table::ExtendNoCheck
+{
+ ## Optmized adding: Assumes $Table and $codepoint as parms
+ $_[0]->[-1]->[RANGE_END] = $_[1];
}
##
## If we've already got a range working, and this code point is the next
## one in line, and if the name is the same, just extend the current range.
##
- if ($Table->NotEmpty
+ my $last = $Table->[-1];
+ if ($last
and
- $Table->Max == $codepoint - 1
+ $last->[RANGE_END] == $codepoint - 1
and
- $Table->[-1]->[RANGE_NAME] eq $name)
+ $last->[RANGE_NAME] eq $name)
{
- $Table->Extend($codepoint);
+ $Table->ExtendNoCheck($codepoint);
}
else
{
if ($start > $New->Max) {
$New->AppendRange($start, $end);
} elsif ($end > $New->Max) {
- $New->Extend($end);
+ $New->ExtendNoCheck($end);
}
}
##
## Given a filename, write a representation of the Table to a file.
## May have an optional comment as a 2nd arg.
+## Filename may actually be an arrayref of directories
##
sub Table::Write
{
{
my $Table = shift; #self
- return 0x1234 if $Table->IsEmpty();
+ return 0x1234 if not @$Table;
for my $set (@$Table)
{
my %General;
my %Cat;
+## Simple Data::Dumper alike. Good enough for our needs. We can't use the real
+## thing as we have to run under miniperl
+sub simple_dumper {
+ my @lines;
+ my $item;
+ foreach $item (@_) {
+ if (ref $item) {
+ if (ref $item eq 'ARRAY') {
+ push @lines, "[\n", simple_dumper (@$item), "],\n";
+ } elsif (ref $item eq 'HASH') {
+ push @lines, "{\n", simple_dumper (%$item), "},\n";
+ } else {
+ die "Can't cope with $item";
+ }
+ } else {
+ if (defined $item) {
+ my $copy = $item;
+ $copy =~ s/([\'\\])/\\$1/gs;
+ push @lines, "'$copy',\n";
+ } else {
+ push @lines, "undef,\n";
+ }
+ }
+ }
+ @lines;
+}
+
##
## Process UnicodeData.txt (Categories, etc.)
##
##
$Name->Write("Name.pl");
+ {
+ my @PVA = $HEADER;
+ foreach my $name (qw (PropertyAlias PA_reverse PropValueAlias
+ PVA_reverse PVA_abbr_map)) {
+ # Should I really jump through typeglob hoops just to avoid a
+ # symbolic reference? (%{"utf8::$name})
+ push @PVA, "\n", "\%utf8::$name = (\n",
+ simple_dumper (%{$utf8::{$name}}), ");\n";
+ }
+ push @PVA, "1;\n";
+ WriteIfChanged("PVA.pl", @PVA);
+ }
+
# $Bidi->Write("Bidirectional.pl");
- mkdir("lib/bc", 0755);
for (keys %Bidi) {
$Bidi{$_}->Write(
- "lib/bc/$_.pl",
+ ["lib","bc","$_.pl"],
"BidiClass category '$PropValueAlias{bc}{$_}'"
);
}
$Comb->Write("CombiningClass.pl");
- mkdir("lib/ccc", 0755);
for (keys %{ $PropValueAlias{ccc} }) {
my ($code, $name) = @{ $PropValueAlias{ccc}{$_} };
(my $c = Table->New())->Append($code);
$c->Write(
- "lib/ccc/$_.pl",
+ ["lib","ccc","$_.pl"],
"CombiningClass category '$name'"
);
}
$Deco->Write("Decomposition.pl");
- mkdir("lib/dt", 0755);
for (keys %DC) {
$DC{$_}->Write(
- "lib/dt/$_.pl",
+ ["lib","dt","$_.pl"],
"DecompositionType category '$PropValueAlias{dt}{$_}'"
);
}
# $Number->Write("Number.pl");
- mkdir("lib/nt", 0755);
for (keys %Number) {
$Number{$_}->Write(
- "lib/nt/$_.pl",
+ ["lib","nt","$_.pl"],
"NumericType category '$PropValueAlias{nt}{$_}'"
);
}
# $General->Write("Category.pl");
for my $to (sort keys %To) {
- $To{$to}->Write("To/$to.pl");
+ $To{$to}->Write(["To","$to.pl"]);
}
for (keys %{ $PropValueAlias{gc} }) {
# $Lbrk->Write("Lbrk.pl");
- mkdir("lib/lb", 0755);
for (keys %Lbrk) {
$Lbrk{$_}->Write(
- "lib/lb/$_.pl",
+ ["lib","lb","$_.pl"],
"Linebreak category '$PropValueAlias{lb}{$_}'"
);
}
# $ArabLink->Write("ArabLink.pl");
# $ArabLinkGroup->Write("ArabLnkGrp.pl");
- mkdir("lib/jt", 0755);
for (keys %JoinType) {
$JoinType{$_}->Write(
- "lib/jt/$_.pl",
+ ["lib","jt","$_.pl"],
"JoiningType category '$PropValueAlias{jt}{$_}'"
);
}
while (<IN>)
{
- next unless /^[0-9A-Fa-f]+;/;
+ next unless /^[0-9A-Fa-f]+(\.\.[0-9A-Fa-f]+)?;/;
s/#.*//;
s/\s+$//;
- my ($hexcode, $pv) = split(/\s*;\s*/);
- my $code = hex($hexcode);
+ my ($hexcodes, $pv) = split(/\s*;\s*/);
$EAW{$pv} ||= Table->New(Is => "EastAsianWidth$pv");
- $EAW{$pv}->Append($code);
+ my ($start, $end) = split(/\.\./, $hexcodes);
+ if (defined $end) {
+ $EAW{$pv}->AppendRange(hex($start), hex($end));
+ } else {
+ $EAW{$pv}->Append(hex($start));
+ }
}
close IN;
- mkdir("lib/ea", 0755);
for (keys %EAW) {
$EAW{$_}->Write(
- "lib/ea/$_.pl",
+ ["lib","ea","$_.pl"],
"EastAsianWidth category '$PropValueAlias{ea}{$_}'"
);
}
}
close IN;
- mkdir("lib/hst", 0755);
-
for (keys %HST) {
$HST{$_}->Write(
- "lib/hst/$_.pl",
+ ["lib","hst","$_.pl"],
"HangulSyllableType category '$PropValueAlias{hst}{$_}'"
);
}
# XXX I'm assuming that the names from %Prop don't suffer 8.3 clashes.
$BaseNames{lc $file}++;
$Prop{$_}->Write(
- "lib/gc_sc/$file.pl",
+ ["lib","gc_sc","$file.pl"],
"Binary property '$_'"
);
}
sub MakePropTestScript()
{
## this written directly -- it's huge.
+ force_unlink ("TestProp.pl");
if (not open OUT, ">TestProp.pl") {
die "$0: TestProp.pl: $!\n";
}
##
## Okay, write the file...
##
- $Table->Write("lib/gc_sc/$filename.pl", $Comment);
+ $Table->Write(["lib","gc_sc","$filename.pl"], $Comment);
## and register it
$RawNameToFile{$Name} = $filename;
$NormalCase,
"END\n"
);
- WriteIfChanged("To/$case.pl", @OUT);
+ WriteIfChanged(["To","$case.pl"], @OUT);
}
}
"END\n",
);
- WriteIfChanged("To/Fold.pl", @OUT);
+ WriteIfChanged(["To","Fold.pl"], @OUT);
}
## Do it....
SpecialCasing_txt();
CaseFolding_txt();
+if ( $FileList and $MakeList ) {
+
+ print "Updating '$FileList'\n"
+ if ($Verbose);
+
+ open my $ofh,">",$FileList
+ or die "Can't write to '$FileList':$!";
+ print $ofh <<"EOFHEADER";
+#
+# mktables.lst -- File list for mktables.
+#
+# Autogenerated on @{[scalar localtime]}
+#
+# - First section is input files
+# (mktables itself is automatically included)
+# - Section seperator is /^=+\$/
+# - Second section is a list of output files.
+# - Lines matching /^\\s*#/ are treated as comments
+# which along with blank lines are ignored.
+#
+
+# Input files:
+
+EOFHEADER
+ my @input=("version",glob('*.txt'));
+ print $ofh "$_\n" for
+ @input,
+ "\n=================================\n",
+ "# Output files:\n",
+ # special files
+ "Properties";
+
+
+ require File::Find;
+ my $count=0;
+ File::Find::find({
+ no_chdir=>1,
+ wanted=>sub {
+ if (/\.pl$/) {
+ s!^\./!!;
+ print $ofh "$_\n";
+ $count++;
+ }
+ },
+ },".");
+
+ print $ofh "\n# ",scalar(@input)," input files\n",
+ "# ",scalar($count+1)," output files\n\n",
+ "# End list\n";
+ close $ofh
+ or warn "Failed to close $ofh: $!";
+
+ print "Filelist has ",scalar(@input)," input files and ",
+ scalar($count+1)," output files\n"
+ if $Verbose;
+}
+print "All done\n" if $Verbose;
exit(0);
## TRAILING CODE IS USED BY MakePropTestScript()
projects / p5sagit/p5-mst-13.2.git / blobdiff