1#! /usr/bin/perl
2#
3# Copyright (c) 2009, Oracle and/or its affiliates.
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
31use strict;
32use warnings;
33
34my $error_count = 0;
35
36if (scalar(@ARGV) == 0) {
37  if ( -f 'Compose' ) {
38    push @ARGV, 'Compose';
39  } else {
40    push @ARGV, glob '*/Compose';
41  }
42}
43
44foreach my $cf (@ARGV) {
45  # print "Checking $cf\n";
46  $error_count += check_compose_file($cf);
47}
48
49exit($error_count);
50
51sub 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
149sub 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}
162