compose-check.pl revision b4ee4795 
1#! /usr/bin/perl
2#
3# Copyright 2009 Sun Microsystems, Inc.  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
31use strict;
32use warnings;
33
34my $error_count = 0;
35
36if (scalar(@ARGV) == 0) {
37  push @ARGV, "Compose";
38}
39
40foreach my $cf (@ARGV) {
41  $error_count += check_compose_file($cf);
42}
43
44exit($error_count);
45
46sub check_compose_file {
47  my ($filename) = @_;
48  my $errors = 0;
49
50  my %compose_table = ();
51  my $line = 0;
52  my $pre_file = ($filename =~ m{\.pre$}) ? 1 : 0;
53  my $in_c_comment = 0;
54
55  open my $COMPOSE, '<', $filename or die "Could not open $filename: $!";
56
57 COMPOSE_LINE:
58  while (my $cl = <$COMPOSE>) {
59    $line++;
60    chomp($cl);
61    my $original_line = $cl;
62
63    # Special handling for changes cpp makes to .pre files
64    if ($pre_file == 1) {
65      if ($in_c_comment) {		# Look for end of multi-line C comment
66	if ($cl =~ m{\*/(.*)$}) {
67	  $cl = $1;
68	  $in_c_comment = 0;
69	} else {
70	  next;
71	}
72      }
73      $cl =~ s{/\*.\**/}{};		# Remove single line C comments
74      if ($cl =~ m{^(.*)/\*}) {		# Start of a multi-line C comment
75	$cl = $1;
76	$in_c_comment = 1;
77      }
78      next if $cl =~ m{^\s*XCOMM};	# Skip pre-processing comments
79    }
80
81    $cl =~ s{#.*$}{};			# Remove comments
82    next if $cl =~ m{^\s*$};		# Skip blank (or comment-only) lines
83    chomp($cl);
84
85    if ($cl =~ m{^(STATE\s+|END_STATE)}) { # Sun extension to compose file syntax
86      %compose_table = ();
87    }
88    elsif ($cl =~ m{^([^:]+)\s*:\s*(.+)$}) {
89      my ($seq, $action) = ($1, $2);
90      $seq =~ s{\s+$}{};
91
92      my @keys = grep { $_ !~ m/^\s*$/ } split /[\s\<\>]+/, $seq;
93
94      my $final_key = pop @keys;
95      my $keytable = \%compose_table;
96
97      foreach my $k (@keys) {
98	if ($k =~ m{^U([[:xdigit:]]+)$}) {
99	  $k = 'U' . lc($1);
100	}
101	if (exists $keytable->{$k}) {
102	  $keytable = $keytable->{$k};
103	  if (ref($keytable) ne 'HASH') {
104	    print
105	      "Clash with existing sequence in $filename on line $line: $seq\n";
106	    print_sequences([$line, $original_line]);
107	    print_sequences($keytable);
108	    $errors++;
109	    next COMPOSE_LINE;
110	  }
111	} else {
112	  my $new_keytable = {};
113	  $keytable->{$k} = $new_keytable;
114	  $keytable = $new_keytable;
115	}
116      }
117
118      if (exists $keytable->{$final_key}) {
119	print "Clash with existing sequence in $filename on line $line: $seq\n";
120	print_sequences([$line, $original_line]);
121	print_sequences($keytable->{$final_key});
122	$errors++;
123      } else {
124	$keytable->{$final_key} = [$line, $original_line];
125      }
126    } elsif ($cl =~ m{^(STATE_TYPE:|\@StartDeadKeyMap|\@EndDeadKeyMap)}) {
127      # ignore
128    } elsif ($cl =~ m{^include "(.*)"}) {
129      my $incpath = $1;
130      if (($pre_file == 1) && ($incpath !~ m{^X11_LOCALEDATADIR/})) {
131	print "Include path starts with $incpath instead of X11_LOCALEDATADIR\n",
132	 " -- may not find include files when installed in alternate paths\n\n";
133      }
134    } else {
135      print 'Unrecognized pattern in ', $filename, ' on line #', $line, ":\n  ",
136	$cl, "\n";
137    }
138  }
139  close $COMPOSE;
140
141  return $errors;
142}
143
144sub print_sequences {
145  my ($entry_ref) = @_;
146
147  if (ref($entry_ref) eq 'HASH') {
148    foreach my $h (values %{$entry_ref}) {
149      print_sequences($h);
150    }
151  } else {
152    my ($line, $seq) = @{$entry_ref};
153
154    print "  line #", $line, ": ", $seq, "\n";
155  }
156}
157