1#! /usr/bin/perl
2#
3# Copyright (c) 2007-2020, PostgreSQL Global Development Group
4#
5# src/backend/utils/mb/Unicode/UCS_to_GB18030.pl
6#
7# Generate UTF-8 <--> GB18030 code conversion tables from
8# "gb-18030-2000.xml", obtained from
9# http://source.icu-project.org/repos/icu/data/trunk/charset/data/xml/
10#
11# The lines we care about in the source file look like
12#    <a u="009A" b="81 30 83 36"/>
13# where the "u" field is the Unicode code point in hex,
14# and the "b" field is the hex byte sequence for GB18030
15
16use strict;
17use warnings;
18
19use convutils;
20
21my $this_script = 'src/backend/utils/mb/Unicode/UCS_to_EUC_CN.pl';
22
23# Read the input
24
25my $in_file = "gb-18030-2000.xml";
26
27open(my $in, '<', $in_file) || die("cannot open $in_file");
28
29my @mapping;
30
31while (<$in>)
32{
33	next if (!m/<a u="([0-9A-F]+)" b="([0-9A-F ]+)"/);
34	my ($u, $c) = ($1, $2);
35	$c =~ s/ //g;
36	my $ucs  = hex($u);
37	my $code = hex($c);
38
39	# The GB-18030 character set, which we use as the source, contains
40	# a lot of extra characters on top of the GB2312 character set that
41	# EUC_CN encodes. Filter out those extra characters.
42	next if (($code & 0xFF) < 0xA1);
43	next
44	  if (
45		!(     $code >= 0xA100 && $code <= 0xA9FF
46			|| $code >= 0xB000 && $code <= 0xF7FF));
47
48	next if ($code >= 0xA2A1 && $code <= 0xA2B0);
49	next if ($code >= 0xA2E3 && $code <= 0xA2E4);
50	next if ($code >= 0xA2EF && $code <= 0xA2F0);
51	next if ($code >= 0xA2FD && $code <= 0xA2FE);
52	next if ($code >= 0xA4F4 && $code <= 0xA4FE);
53	next if ($code >= 0xA5F7 && $code <= 0xA5FE);
54	next if ($code >= 0xA6B9 && $code <= 0xA6C0);
55	next if ($code >= 0xA6D9 && $code <= 0xA6FE);
56	next if ($code >= 0xA7C2 && $code <= 0xA7D0);
57	next if ($code >= 0xA7F2 && $code <= 0xA7FE);
58	next if ($code >= 0xA8BB && $code <= 0xA8C4);
59	next if ($code >= 0xA8EA && $code <= 0xA8FE);
60	next if ($code >= 0xA9A1 && $code <= 0xA9A3);
61	next if ($code >= 0xA9F0 && $code <= 0xA9FE);
62	next if ($code >= 0xD7FA && $code <= 0xD7FE);
63
64	# A couple of characters are mapped differently from GB-2312 or GB-18030
65	if ($code == 0xA1A4)
66	{
67		$ucs = 0x30FB;
68	}
69	if ($code == 0xA1AA)
70	{
71		$ucs = 0x2015;
72	}
73
74	push @mapping,
75	  {
76		ucs       => $ucs,
77		code      => $code,
78		direction => BOTH,
79		f         => $in_file,
80		l         => $.
81	  };
82}
83close($in);
84
85print_conversion_tables($this_script, "EUC_CN", \@mapping);
86