1*a15691bfSXin LI#! /usr/bin/perl 2*a15691bfSXin LIuse strict; 3*a15691bfSXin LI 4*a15691bfSXin LImy $USAGE = <<__EOF__; 5*a15691bfSXin LI usage: mkutable [-n] [-f#] type... [--] [<] UnicodeData.txt 6*a15691bfSXin LI -n = take non-matching types 7*a15691bfSXin LI -f = zero-based type field (default 2) 8*a15691bfSXin LI__EOF__ 9*a15691bfSXin LI 10*a15691bfSXin LIuse vars qw( $opt_f $opt_n ); 11*a15691bfSXin LIuse Getopt::Std; 12*a15691bfSXin LImy $type_field = 2; 13*a15691bfSXin LI 14*a15691bfSXin LIexit (main() ? 1 : 0); 15*a15691bfSXin LI 16*a15691bfSXin LIsub main { 17*a15691bfSXin LI my $date = `date`; 18*a15691bfSXin LI chomp $date; 19*a15691bfSXin LI my $args = join ' ', @ARGV; 20*a15691bfSXin LI my $header = "/* Generated by \"$0 $args\" on $date */\n"; 21*a15691bfSXin LI 22*a15691bfSXin LI die $USAGE if not getopts('f:n'); 23*a15691bfSXin LI $type_field = $opt_f if $opt_f; 24*a15691bfSXin LI my %types; 25*a15691bfSXin LI my $arg; 26*a15691bfSXin LI while ($arg = shift @ARGV) { 27*a15691bfSXin LI last if $arg eq '--'; 28*a15691bfSXin LI $types{$arg} = 1; 29*a15691bfSXin LI } 30*a15691bfSXin LI my %out = ( 'types' => \%types ); 31*a15691bfSXin LI my $last_code = 0; 32*a15691bfSXin LI 33*a15691bfSXin LI print $header; 34*a15691bfSXin LI while (<>) { 35*a15691bfSXin LI chomp; 36*a15691bfSXin LI s/#.*//; 37*a15691bfSXin LI my @fields = split /;/; 38*a15691bfSXin LI next if not @fields; 39*a15691bfSXin LI my $code = hex $fields[0]; 40*a15691bfSXin LI my $type = $fields[$type_field]; 41*a15691bfSXin LI $type =~ s/\s//g; 42*a15691bfSXin LI while (++$last_code < $code) { 43*a15691bfSXin LI output(\%out, $last_code, '?'); 44*a15691bfSXin LI } 45*a15691bfSXin LI output(\%out, $code, $type); 46*a15691bfSXin LI } 47*a15691bfSXin LI output(\%out, $last_code+1, '?'); 48*a15691bfSXin LI} 49*a15691bfSXin LI 50*a15691bfSXin LIsub output { 51*a15691bfSXin LI my ($out, $code, $type) = @_; 52*a15691bfSXin LI my $match = ${${$out}{types}}{$type}; 53*a15691bfSXin LI my $type_change = (not $$out{start_type} or $type ne $$out{start_type}); 54*a15691bfSXin LI $match = not $match if $opt_n; 55*a15691bfSXin LI if ($match and (not $$out{in_run} or $type_change)) { 56*a15691bfSXin LI end_run($out, $code-1); 57*a15691bfSXin LI start_run($out, $code, $type); 58*a15691bfSXin LI } elsif (not $match and $$out{in_run}) { 59*a15691bfSXin LI end_run($out, $code-1); 60*a15691bfSXin LI } 61*a15691bfSXin LI} 62*a15691bfSXin LI 63*a15691bfSXin LIsub start_run { 64*a15691bfSXin LI my ($out, $code, $type) = @_; 65*a15691bfSXin LI $$out{start_code} = $code; 66*a15691bfSXin LI $$out{start_type} = $type; 67*a15691bfSXin LI $$out{in_run} = 1; 68*a15691bfSXin LI} 69*a15691bfSXin LI 70*a15691bfSXin LIsub end_run { 71*a15691bfSXin LI my ($out, $code) = @_; 72*a15691bfSXin LI return if not $$out{in_run}; 73*a15691bfSXin LI printf "\t{ 0x%04x, 0x%04x }, /* %s */\n", $$out{start_code}, $code, $$out{start_type}; 74*a15691bfSXin LI $$out{in_run} = 0; 75*a15691bfSXin LI} 76