nls/compose-check.pl

   1 #! /usr/bin/perl
   2 #
   3 # Copyright 2009 Oracle and/or its affiliates. All rights reserved.
   4 #
   5 # Permission is hereby granted, free of charge, to any person obtaining a
   6 # copy of this software and associated documentation files (the "Software"),
   7 # to deal in the Software without restriction, including without limitation
   8 # the rights to use, copy, modify, merge, publish, distribute, sublicense,
   9 # and/or sell copies of the Software, and to permit persons to whom the
  10 # Software is furnished to do so, subject to the following conditions:
  11 #
  12 # The above copyright notice and this permission notice (including the next
  13 # paragraph) shall be included in all copies or substantial portions of the
  14 # Software.
  15 #
  16 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  17 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  18 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
  19 # THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  20 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  21 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  22 # DEALINGS IN THE SOFTWARE.
  23 #
  24
  25 #
  26 # Check a compose file for duplicate/conflicting entries and other common errors
  27 #
  28
  29 # Compose file grammar is defined in modules/im/ximcp/imLcPrs.c
  30
  31 use strict;
  32 use warnings;
  33
  34 my $error_count = 0;
  35
  36 if (scalar(@ARGV) == 0) {
  37   if ( -f 'Compose' ) {
  38     push @ARGV, 'Compose';
  39   } else {
  40     push @ARGV, glob '*/Compose';
  41   }
  42 }
  43
  44 foreach my $cf (@ARGV) {
  45   # print "Checking $cf\n";
  46   $error_count += check_compose_file($cf);
  47 }
  48
  49 exit($error_count);
  50
  51 sub check_compose_file {
  52   my ($filename) = @_;
  53   my $errors = 0;
  54
  55   my %compose_table = ();
  56   my $line = 0;
  57   my $pre_file = ($filename =~ m{\.pre$}) ? 1 : 0;
  58   my $in_c_comment = 0;
  59
  60   open my $COMPOSE, '<', $filename or die "Could not open $filename: $!";
  61
  62  COMPOSE_LINE:
  63   while (my $cl = <$COMPOSE>) {
  64     $line++;
  65     chomp($cl);
  66     my $original_line = $cl;
  67
  68     # Special handling for changes cpp makes to .pre files
  69     if ($pre_file == 1) {
  70       if ($in_c_comment) {              # Look for end of multi-line C comment
  71         if ($cl =~ m{\*/(.*)$}) {
  72           $cl = $1;
  73           $in_c_comment = 0;
  74         } else {
  75           next;
  76         }
  77       }
  78       $cl =~ s{/\*.\**/}{};             # Remove single line C comments
  79       if ($cl =~ m{^(.*)/\*}) {         # Start of a multi-line C comment
  80         $cl = $1;
  81         $in_c_comment = 1;
  82       }
  83       next if $cl =~ m{^\s*XCOMM};      # Skip pre-processing comments
  84     }
  85
  86     $cl =~ s{#.*$}{};                   # Remove comments
  87     next if $cl =~ m{^\s*$};            # Skip blank (or comment-only) lines
  88     chomp($cl);
  89
  90     if ($cl =~ m{^(STATE\s+|END_STATE)}) { # Sun extension to compose file syntax
  91       %compose_table = ();
  92     }
  93     elsif ($cl =~ m{^([^:]+)\s*:\s*(.+)$}) {
  94       my ($seq, $action) = ($1, $2);
  95       $seq =~ s{\s+$}{};
  96
  97       my @keys = grep { $_ !~ m/^\s*$/ } split /[\s\<\>]+/, $seq;
  98
  99       my $final_key = pop @keys;
 100       my $keytable = \%compose_table;
 101
 102       foreach my $k (@keys) {
 103         if ($k =~ m{^U([[:xdigit:]]+)$}) {
 104           $k = 'U' . lc($1);
 105         }
 106         if (exists $keytable->{$k}) {
 107           $keytable = $keytable->{$k};
 108           if (ref($keytable) ne 'HASH') {
 109             print
 110               "Clash with existing sequence in $filename on line $line: $seq\n";
 111             print_sequences([$line, $original_line]);
 112             print_sequences($keytable);
 113             $errors++;
 114             next COMPOSE_LINE;
 115           }
 116         } else {
 117           my $new_keytable = {};
 118           $keytable->{$k} = $new_keytable;
 119           $keytable = $new_keytable;
 120         }
 121       }
 122
 123       if (exists $keytable->{$final_key}) {
 124         print "Clash with existing sequence in $filename on line $line: $seq\n";
 125         print_sequences([$line, $original_line]);
 126         print_sequences($keytable->{$final_key});
 127         $errors++;
 128       } else {
 129         $keytable->{$final_key} = [$line, $original_line];
 130       }
 131     } elsif ($cl =~ m{^(STATE_TYPE:|\@StartDeadKeyMap|\@EndDeadKeyMap)}) {
 132       # ignore
 133     } elsif ($cl =~ m{^include "(.*)"}) {
 134       my $incpath = $1;
 135       if (($pre_file == 1) && ($incpath !~ m{^X11_LOCALEDATADIR/})) {
 136         print "Include path starts with $incpath instead of X11_LOCALEDATADIR\n",
 137          " -- may not find include files when installed in alternate paths\n\n";
 138       }
 139     } else {
 140       print 'Unrecognized pattern in ', $filename, ' on line #', $line, ":\n  ",
 141         $cl, "\n";
 142     }
 143   }
 144   close $COMPOSE;
 145
 146   return $errors;
 147 }
 148
 149 sub print_sequences {
 150   my ($entry_ref) = @_;
 151
 152   if (ref($entry_ref) eq 'HASH') {
 153     foreach my $h (values %{$entry_ref}) {
 154       print_sequences($h);
 155     }
 156   } else {
 157     my ($line, $seq) = @{$entry_ref};
 158
 159     print "  line #", $line, ": ", $seq, "\n";
 160   }
 161 }