pintos-os.org Git - pspp/blob - src/data/sys-file-encoding.pl

   1 #! /usr/bin/perl
   2 #    Copyright (C) 2020  Free Software Foundation
   3
   4 #    This program is free software: you can redistribute it and/or modify
   5 #    it under the terms of the GNU General Public License as published by
   6 #    the Free Software Foundation, either version 3 of the License, or
   7 #    (at your option) any later version.
   8
   9 #    This program is distributed in the hope that it will be useful,
  10 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 #    GNU General Public License for more details.
  13
  14 #    You should have received a copy of the GNU General Public License
  15 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17
  18 use strict;
  19 use warnings;
  20
  21 if (-t 0 || @ARGV) {
  22     print <<EOF;
  23 $0: generate code page tables from ICU encoding list
  24 usage: $0 < convrtrs.txt > sys-file-encoding.c
  25
  26 To regenerate the encoding data, get the latest ICU encoding data from:
  27 http://source.icu-project.org/repos/icu/icu/trunk/source/data/mappings/convrtrs.txt
  28 then convert it with this script using the command above.
  29 EOF
  30     exit (@ARGV && $ARGV[0] eq '--help' ? 0 : 1);
  31 }
  32
  33 open (CONVERTERS, '<', 'convrtrs.txt')
  34   or die "convrtrs.txt: open failed ($!)\n";
  35
  36 our $WINDOWS = 3;               # Windows code pages.
  37 our $IBM = 2;                   # IBM code pages.
  38 our $CP = 1;                    # Java (?) code pages.
  39 our %sources = ($WINDOWS => "windows", $IBM => "ibm", $CP => "cp");
  40
  41 my $converter = "";
  42 while (<CONVERTERS>) {
  43     chomp;
  44     s/#.*//;
  45     if (s/^\s+//) {
  46         $converter .= " $_";
  47     } else {
  48         process_converter ($converter);
  49         $converter = $_;
  50     }
  51 }
  52 process_converter ($converter);
  53 close (CONVERTERS);
  54
  55 our %codepages;
  56
  57 print <<'EOF';
  58 /* -*- mode: c; buffer-read-only: t -*-
  59
  60    Generated by sys-file-encoding.pl.  Do not modify!
  61 */
  62
  63 /*
  64 PSPP - a program for statistical analysis.
  65 Copyright (C) 2017 Free Software Foundation, Inc.
  66
  67 This program is free software: you can redistribute it and/or modify
  68 it under the terms of the GNU General Public License as published by
  69 the Free Software Foundation, either version 3 of the License, or
  70 (at your option) any later version.
  71
  72 This program is distributed in the hope that it will be useful,
  73 but WITHOUT ANY WARRANTY; without even the implied warranty of
  74 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  75 GNU General Public License for more details.
  76
  77 You should have received a copy of the GNU General Public License
  78 along with this program.  If not, see <http://www.gnu.org/licenses/>.
  79 */
  80
  81 #include <config.h>
  82
  83 #include "data/sys-file-private.h"
  84
  85 struct sys_encoding sys_codepage_number_to_name[] = {
  86 EOF
  87 for my $cpnumber (sort { $a <=> $b } (keys (%codepages))) {
  88     my $source = max (keys (%{$codepages{$cpnumber}}));
  89     my $name = ${$codepages{$cpnumber}{$source}}[0];
  90     print "  { $cpnumber, \"$name\" },\n";
  91 }
  92 print "  { 0, NULL }\n";
  93 print "};\n\n";
  94
  95 my %names;
  96 for my $cpnumber (sort { $a <=> $b } (keys (%codepages))) {
  97     for my $source (keys (%{$codepages{$cpnumber}})) {
  98         for my $name (@{$codepages{$cpnumber}{$source}}) {
  99             push(@{$names{$name}{$source}}, $cpnumber);
 100         }
 101     }
 102 }
 103 print "struct sys_encoding sys_codepage_name_to_number[] = {\n";
 104 for my $name (sort (keys (%names))) {
 105     for my $source (reverse (sort (keys (%sources)))) {
 106         next if !exists ($names{$name}{$source});
 107         my (@numbers) = @{$names{$name}{$source}};
 108
 109         # The only two encodings that currently print this are KSC_5601
 110         # and KS_C_5601-1987, for code pages 949 and 51949.  It looks to
 111         # me like the correct code page number is 949, which is the one
 112         # chosen (because the numbers are in sorted order).
 113         print "  /* $name has multiple numbers for $sources{$source}: @numbers */\n"
 114           if @numbers > 1;
 115
 116         print "  { $numbers[0], \"$name\" },\n";
 117         last;
 118     }
 119 }
 120 print "  { 0, NULL }\n";
 121 print "};\n";
 122
 123 sub process_converter {
 124     my ($converter) = @_;
 125     return if $converter =~ /^\s*$/;
 126     return if $converter =~ /^\s*\{/;
 127
 128     my %cps;
 129     my @iana;
 130     my @other;
 131
 132     my @fields = split (' ', $converter);
 133     while (@fields) {
 134         my $name = shift (@fields);
 135         if (@fields && $fields[0] eq '{') {
 136             shift (@fields);
 137
 138             my (%standards);
 139             for (;;) {
 140                 my $standard = shift (@fields);
 141                 last if $standard eq '}';
 142                 $standards{$standard} = 1;
 143             }
 144             if (exists $standards{'IANA*'}) {
 145                 unshift (@iana, $name);
 146             } elsif (exists $standards{'IANA'}) {
 147                 push (@iana, $name);
 148             } elsif (grep (/\*$/, keys %standards)) {
 149                 unshift (@other, $name);
 150             } else {
 151                 push (@other, $name);
 152             }
 153         } else {
 154             # Untagged names are completely nonstandard.
 155             next;
 156         }
 157
 158         my $number;
 159         if (($number) = $name =~ /^cp([0-9]+)$/) {
 160             $cps{$CP} = int ($number);
 161         } elsif (($number) = $name =~ /^windows-([0-9]+)$/) {
 162             $cps{$WINDOWS} = int ($number);
 163         } elsif (($number) = $name =~ /^ibm-([0-9]+)$/) {
 164             $cps{$IBM} = int ($number);
 165         } else {
 166             next;
 167         }
 168     }
 169
 170     # If there are no tagged names then this is completely nonstandard.
 171     return if !@iana && !@other;
 172
 173     $codepages{$cps{$_}}{$_} = [@iana, @other] for keys (%cps);
 174 }
 175
 176 sub max {
 177     my ($best);
 178     for my $x (@_) {
 179         $best = $x if !defined ($best) || $x > $best;
 180     }
 181     return $best;
 182 }