File Coverage

File:lib/CheckSpelling/SpellingCollator.pm
Coverage:83.1%

linestmtbrancondsubtimecode
1#! -*-perl-*-
2
3package CheckSpelling::SpellingCollator;
4
5our $VERSION='0.1.0';
6
1
1
1
109582
2
26
use warnings;
7
1
1
1
1
1
20
use File::Path qw(remove_tree);
8
1
1
1
220
1
2225
use CheckSpelling::Util;
9
10my %letter_map;
11my %ignored_event_map;
12my $disable_word_collating;
13
14sub get_field {
15
28
22
  my ($record, $field) = @_;
16
28
318
  return 0 unless $record =~ (/\b$field:\s*(\d+)/);
17
16
21
  return $1;
18}
19
20sub get_array {
21
2
2
  my ($record, $field) = @_;
22
2
14
  return () unless $record =~ (/\b$field: \[([^\]]+)\]/);
23
2
2
  my $values = $1;
24
2
3
  return split /\s*,\s*/, $values;
25}
26
27sub maybe {
28
7
3
  my ($next, $value) = @_;
29
7
9
  $next = $value unless $next && $next < $value;
30
7
5
  return $next;
31}
32
33my %expected = ();
34sub expect_item {
35
98
60
  my ($item, $value) = @_;
36
98
59
  our %expected;
37
98
32
  my $next;
38
98
94
  if (defined $expected{$item}) {
39
26
15
    $next = $expected{$item};
40
26
22
    $next = $value if $value < $next;
41  } elsif ($item =~ /^([A-Z])(.*)/) {
42
12
10
    $item = $1 . lc $2;
43
12
8
    if (defined $expected{$item}) {
44
2
1
      $next = $expected{$item};
45
2
5
      $next = maybe($next, $value + .1);
46    } else {
47
10
5
      $item = lc $item;
48
10
10
      if (defined $expected{$item}) {
49
5
1
        $next = $expected{$item};
50
5
5
        $next = maybe($next, $value + .2);
51      }
52    }
53  }
54
98
86
  return 0 unless defined $next;
55
33
22
  $expected{$item} = $next;
56
33
65
  return $value;
57}
58
59sub skip_item {
60
52
30
  my ($word) = @_;
61
52
27
  return 1 if expect_item($word, 1);
62
32
20
  my $key = lc $word;
63
32
13
  return 2 if expect_item($key, 2);
64
32
41
  if ($key =~ /.s$/) {
65
2
2
    if ($key =~ /ies$/) {
66
1
2
      $key =~ s/ies$/y/;
67    } else {
68
1
2
      $key =~ s/s$//;
69    }
70  } elsif ($key =~ /^(.+[^aeiou])ed$/) {
71
1
1
    $key = $1;
72  } elsif ($key =~ /^(.+)'[ds]$/) {
73
6
4
    $key = $1;
74  } else {
75
23
20
    return 0;
76  }
77
9
7
  return 3 if expect_item($key, 3);
78
0
0
  return 0;
79}
80
81sub log_skip_item {
82
48
54
  my ($item, $file, $warning, $unknown_word_limit) = @_;
83
48
30
  return 1 if skip_item($item);
84
19
10
  my $seen_count = $seen{$item};
85
19
16
  if (defined $seen_count) {
86
6
8
    if (!defined $unknown_word_limit || ($seen_count++ < $unknown_word_limit)) {
87
5
28
      print MORE_WARNINGS "$file$warning\n"
88    } else {
89
1
2
      $last_seen{$item} = "$file$warning";
90    }
91
6
5
    $seen{$item} = $seen_count;
92
6
9
    return 1;
93  }
94
13
11
  $seen{$item} = 1;
95
13
15
  return 0;
96}
97
98sub stem_word {
99
22
10
  my ($key) = @_;
100
22
8
  our $disable_word_collating;
101
22
12
  return $key if $disable_word_collating;
102
103
22
22
  if ($key =~ /.s$/) {
104
3
6
    if ($key =~ /ies$/) {
105
1
1
      $key =~ s/ies$/y/;
106    } else {
107
2
2
      $key =~ s/s$//;
108    }
109  } elsif ($key =~ /.[^aeiou]ed$/) {
110
1
2
    $key =~ s/ed$//;
111  }
112
22
15
  return $key;
113}
114
115sub collate_key {
116
77
56
  my ($key) = @_;
117
77
21
  our $disable_word_collating;
118
77
57
  if ($disable_word_collating) {
119
16
17
    $char = lc substr $key, 0, 1;
120  } else {
121
61
36
    $key = lc $key;
122
61
47
    $key =~ s/''+/'/g;
123
61
27
    $key =~ s/'[sd]$//;
124
61
43
    $key =~ s/^[^Ii]?'+(.*)/$1/;
125
61
23
    $key =~ s/(.*?)'$/$1/;
126
61
57
    $char = substr $key, 0, 1;
127  }
128
77
106
  return ($key, $char);
129}
130
131sub load_expect {
132
9
461
  my ($expect) = @_;
133
9
24
  our %expected;
134
9
9
  %expected = ();
135
9
72
  if (open(EXPECT, '<:utf8', $expect)) {
136
9
44
    while ($word = <EXPECT>) {
137
34
53
      $word =~ s/\R//;
138
34
59
      $expected{$word} = 0;
139    }
140
9
22
    close EXPECT;
141  }
142}
143
144sub harmonize_expect {
145
8
3
  our $disable_word_collating;
146
8
6
  our %letter_map;
147
8
2
  our %expected;
148
149
8
9
  for my $word (keys %expected) {
150
31
19
    my ($key, $char) = collate_key $word;
151
31
18
    my %word_map = ();
152
31
36
    next unless defined $letter_map{$char}{$key};
153
15
15
3
20
    %word_map = %{$letter_map{$char}{$key}};
154
15
17
    next if defined $word_map{$word};
155
3
1
    my $words = scalar keys %word_map;
156
3
3
    next if $words > 2;
157
3
2
    if ($word eq $key) {
158
1
2
      next if ($words > 1);
159    }
160
2
2
    delete $expected{$word};
161  }
162}
163
164sub group_related_words {
165
9
1
  our %letter_map;
166
9
6
  our $disable_word_collating;
167
9
4
  return if $disable_word_collating;
168
169  # group related words
170
7
17
  for my $char (sort CheckSpelling::Util::number_biased keys %letter_map) {
171
19
19
5
21
    for my $plural_key (sort keys(%{$letter_map{$char}})) {
172
22
18
      my $key = stem_word $plural_key;
173
22
23
      next if $key eq $plural_key;
174
4
4
      next unless defined $letter_map{$char}{$key};
175
3
3
0
4
      my %word_map = %{$letter_map{$char}{$key}};
176
3
3
3
3
      for $word (keys(%{$letter_map{$char}{$plural_key}})) {
177
3
2
        $word_map{$word} = 1;
178      }
179
3
2
      $letter_map{$char}{$key} = \%word_map;
180
3
4
      delete $letter_map{$char}{$plural_key};
181    }
182  }
183}
184
185sub count_warning {
186
10
7
  my ($warning) = @_;
187
10
3
  our %counters;
188
10
5
  our %ignored_event_map;
189
10
19
  if ($warning =~ /\(([-\w]+)\)$/) {
190
8
7
    my ($code) = ($1);
191
8
17
    next if defined $ignored_event_map{$code};
192
8
9
    ++$counters{$code};
193  }
194}
195
196sub report_timing {
197
0
0
  my ($name, $start_time, $directory, $marker) = @_;
198
0
0
  my $end_time = (stat "$directory/$marker")[9];
199
0
0
  $name =~ s/"/\\"/g;
200
0
0
  print TIMING_REPORT "\"$name\", $start_time, $end_time\n";
201}
202
203sub get_pattern_with_context {
204
18
11
  my ($path) = @_;
205
18
20
  return unless defined $ENV{$path};
206
9
9
  $ENV{$path} =~ /(.*)/;
207
9
52
  return unless open ITEMS, '<:utf8', $1;
208
209
9
8
  my @items;
210
9
3
  my $context = '';
211
9
48
  while (<ITEMS>) {
212
2
3
    my $pattern = $_;
213
2
4
    if ($pattern =~ /^#/) {
214
1
2
      if ($pattern =~ /^# /) {
215
1
4
        $context .= $pattern;
216      } else {
217
0
0
        $context = '';
218      }
219
1
5
      next;
220    }
221
1
2
    chomp $pattern;
222
1
3
    unless ($pattern =~ /./) {
223
0
0
      $context = '';
224
0
0
      next;
225    }
226
1
2
    push @items, $context.$pattern;
227
1
3
    $context = '';
228  }
229
9
24
  close ITEMS;
230
9
10
  return @items;
231}
232
233sub summarize_totals {
234
18
15
  my ($formatter, $path, $items, $totals, $file_counts) = @_;
235
18
18
11
15
  return unless @{$totals};
236
1
21
  return unless open my $fh, '>:utf8', $path;
237
1
1
0
1
  my $totals_count = scalar(@{$totals}) - 1;
238
1
1
  my @indices;
239
1
1
  if ($file_counts) {
240    @indices = sort {
241
0
0
0
0
      $totals->[$b] <=> $totals->[$a] ||
242      $file_counts->[$b] <=> $file_counts->[$a]
243    } 0 .. $totals_count;
244  } else {
245    @indices = sort {
246
1
0
1
0
      $totals->[$b] <=> $totals->[$a]
247    } 0 .. $totals_count;
248  }
249
1
1
  for my $i (@indices) {
250
1
2
    last unless $totals->[$i] > 0;
251
1
1
    my $rule_with_context = $items->[$i];
252
1
1
    my ($description, $rule);
253
1
3
    if ($rule_with_context =~ /^(.*\n)([^\n]+)$/s) {
254
1
1
      ($description, $rule) = ($1, $2);
255    } else {
256
0
0
      ($description, $rule) = ('', $rule_with_context);
257    }
258
1
2
    print $fh $formatter->(
259      $totals->[$i],
260      ($file_counts ? " file-count: $file_counts->[$i]" : ""),
261      $description,
262      $rule
263    );
264  }
265
1
30
  close $fh;
266}
267
268sub main {
269
9
15857
  my @directories;
270  my @cleanup_directories;
271
9
0
  my @check_file_paths;
272
273
9
11
  my $early_warnings = CheckSpelling::Util::get_file_from_env('early_warnings', '/dev/null');
274
9
9
  my $warning_output = CheckSpelling::Util::get_file_from_env('warning_output', '/dev/stderr');
275
9
6
  my $more_warnings = CheckSpelling::Util::get_file_from_env('more_warnings', '/dev/stderr');
276
9
4
  my $counter_summary = CheckSpelling::Util::get_file_from_env('counter_summary', '/dev/stderr');
277
9
5
  my $ignored_events = CheckSpelling::Util::get_file_from_env('ignored_events', '');
278
9
8
  if ($ignored_events) {
279
0
0
    our %ignored_event_map;
280
0
0
    for my $event (split /,/, $ignored_events) {
281
0
0
      $ignored_event_map{$event} = 1;
282    }
283  }
284
9
7
  my $should_exclude_file = CheckSpelling::Util::get_file_from_env('should_exclude_file', '/dev/null');
285
9
4
  my $unknown_word_limit = CheckSpelling::Util::get_val_from_env('unknown_word_limit', undef);
286
9
5
  my $unknown_file_word_limit = CheckSpelling::Util::get_val_from_env('unknown_file_word_limit', undef);
287
9
4
  my $candidate_example_limit = CheckSpelling::Util::get_file_from_env('INPUT_CANDIDATE_EXAMPLE_LIMIT', '3');
288
9
4
  my $disable_flags = CheckSpelling::Util::get_file_from_env('INPUT_DISABLE_CHECKS', '');
289
9
5
  my $only_check_changed_files = CheckSpelling::Util::get_file_from_env('INPUT_ONLY_CHECK_CHANGED_FILES', '');
290
9
5
  my $disable_noisy_file = $disable_flags =~ /(?:^|,|\s)noisy-file(?:,|\s|$)/;
291
9
24
  our $disable_word_collating = $only_check_changed_files || $disable_flags =~ /(?:^|,|\s)word-collating(?:,|\s|$)/;
292
9
7
  my $file_list = CheckSpelling::Util::get_file_from_env('check_file_names', '');
293
9
6
  my $timing_report = CheckSpelling::Util::get_file_from_env('timing_report', '');
294
9
6
  my ($start_time, $end_time);
295
296
9
191
  open WARNING_OUTPUT, '>:utf8', $warning_output;
297
9
132
  open MORE_WARNINGS, '>:utf8', $more_warnings;
298
9
110
  open COUNTER_SUMMARY, '>:utf8', $counter_summary;
299
9
67
  open SHOULD_EXCLUDE, '>:utf8', $should_exclude_file;
300
9
9
  if ($timing_report) {
301
0
0
    open TIMING_REPORT, '>:utf8', $timing_report;
302
0
0
    print TIMING_REPORT "file, start, finish\n";
303  }
304
305
9
8
  my @candidates = get_pattern_with_context('candidates_path');
306
9
4
  my @candidate_totals = (0) x scalar @candidates;
307
9
6
  my @candidate_file_counts = (0) x scalar @candidates;
308
309
9
4
  my @forbidden = get_pattern_with_context('forbidden_path');
310
9
5
  my @forbidden_totals = (0) x scalar @forbidden;
311
312
9
7
  my @delayed_warnings;
313
9
17
  our %letter_map = ();
314
315
9
4
  my %file_map = ();
316
317
9
21
  for my $directory (<>) {
318
12
11
    chomp $directory;
319
12
21
    next unless $directory =~ /^(.*)$/;
320
12
9
    $directory = $1;
321
12
36
    unless (-e $directory) {
322
1
3
      print STDERR "Could not find: $directory\n";
323
1
1
      next;
324    }
325
11
26
    unless (-d $directory) {
326
1
10
      print STDERR "Not a directory: $directory\n";
327
1
2
      next;
328    }
329
330    # if there's no filename, we can't report
331
10
67
    next unless open(NAME, '<:utf8', "$directory/name");
332
9
48
    my $file=<NAME>;
333
9
18
    close NAME;
334
335
9
18
    $file_map{$file} = $directory;
336  }
337
338
9
14
  for my $file (sort keys %file_map) {
339
9
5
    my $directory = $file_map{$file};
340
9
9
    if ($timing_report) {
341
0
0
      $start_time = (stat "$directory/name")[9];
342    }
343
344
9
44
    if (-e "$directory/skipped") {
345
1
7
      open SKIPPED, '<:utf8', "$directory/skipped";
346
1
6
      my $reason=<SKIPPED>;
347
1
2
      close SKIPPED;
348
1
1
      chomp $reason;
349
1
3
      push @delayed_warnings, "$file:1:1 ... 1, Warning - Skipping `$file` because $reason\n";
350
1
4
      print SHOULD_EXCLUDE "$file\n";
351
1
6
      push @cleanup_directories, $directory;
352
1
2
      report_timing($file, $start_time, $directory, 'skipped') if ($timing_report);
353
1
1
      next;
354    }
355
356    # stats isn't written if there was nothing interesting in the file
357
8
24
    unless (-s "$directory/stats") {
358
1
1
      push @directories, $directory;
359
1
1
      report_timing($file, $start_time, $directory, 'warnings') if ($timing_report);
360
1
1
      next;
361    }
362
363
7
7
    if ($file eq $file_list) {
364
1
6
      open FILE_LIST, '<:utf8', $file_list;
365
1
1
      push @check_file_paths, '0 placeholder';
366
1
5
      for my $check_file_path (<FILE_LIST>) {
367
4
3
        chomp $check_file_path;
368
4
4
        push @check_file_paths, $check_file_path;
369      }
370
1
2
      close FILE_LIST;
371    }
372
373
7
3
    my ($words, $unrecognized, $unknown, $unique);
374
375    {
376
7
7
6
35
      open STATS, '<:utf8', "$directory/stats";
377
7
26
      my $stats=<STATS>;
378
7
11
      close STATS;
379
7
7
      $words=get_field($stats, 'words');
380
7
5
      $unrecognized=get_field($stats, 'unrecognized');
381
7
7
      $unknown=get_field($stats, 'unknown');
382
7
4
      $unique=get_field($stats, 'unique');
383
7
3
      my @candidate_list;
384
7
6
      if (@candidate_totals) {
385
0
0
        @candidate_list=get_array($stats, 'candidates');
386
0
0
        my @lines=get_array($stats, 'candidate_lines');
387
0
0
        if (@candidate_list) {
388
0
0
          for (my $i=0; $i < scalar @candidate_list; $i++) {
389
0
0
            my $hits = $candidate_list[$i];
390
0
0
            if ($hits) {
391
0
0
              $candidate_totals[$i] += $hits;
392
0
0
              if ($candidate_file_counts[$i]++ < $candidate_example_limit) {
393
0
0
                my $pattern = (split /\n/,$candidates[$i])[-1];
394
0
0
                my $position = $lines[$i];
395
0
0
                $position =~ s/:(\d+)$/ ... $1/;
396
0
0
                my $wrapped = CheckSpelling::Util::wrap_in_backticks($pattern);
397
0
0
                push @delayed_warnings, "$file:$position, Notice - Line matches candidate pattern $wrapped (candidate-pattern)\n";
398              }
399            }
400          }
401        }
402      }
403
7
8
      if (@forbidden_totals) {
404
1
1
        @forbidden_list=get_array($stats, 'forbidden');
405
1
1
        my @lines=get_array($stats, 'forbidden_lines');
406
1
1
        if (@forbidden_list) {
407
1
1
          for (my $i=0; $i < scalar @forbidden_list; $i++) {
408
1
1
            my $hits = $forbidden_list[$i];
409
1
1
            if ($hits) {
410
1
2
              $forbidden_totals[$i] += $hits;
411            }
412          }
413        }
414      }
415      #print STDERR "$file (unrecognized: $unrecognized; unique: $unique; unknown: $unknown, words: $words, candidates: [".join(", ", @candidate_list)."])\n";
416    }
417
418
7
4
    report_timing($file, $start_time, $directory, 'unknown') if ($timing_report);
419    # These heuristics are very new and need tuning/feedback
420
7
7
    if (
421        ($unknown > $unique)
422        # || ($unrecognized > $words / 2)
423    ) {
424
0
0
      unless ($disable_noisy_file) {
425
0
0
        if ($file ne $file_list) {
426
0
0
          push @delayed_warnings, "$file:1:1 ... 1, Warning - Skipping `$file` because it seems to have more noise ($unknown) than unique words ($unique) (total: $unrecognized / $words). (noisy-file)\n";
427
0
0
          print SHOULD_EXCLUDE "$file\n";
428        } else {
429
0
0
          push @delayed_warnings, "$file:1:1 ... 1, Warning - Skipping file list because there seems to be more noise ($unknown) than unique words ($unique) (total: $unrecognized / $words). (noisy-file-list)\n";
430        }
431
0
0
        push @directories, $directory;
432
0
0
        next;
433      }
434    }
435
7
28
    unless (-s "$directory/unknown") {
436
1
1
      push @directories, $directory;
437
1
1
      next;
438    }
439
6
37
    open UNKNOWN, '<:utf8', "$directory/unknown";
440
6
41
    for $token (<UNKNOWN>) {
441
49
54
      $token =~ s/\R//;
442
49
41
      next unless $token =~ /./;
443
46
25
      my ($key, $char) = collate_key $token;
444
46
51
      $letter_map{$char} = () unless defined $letter_map{$char};
445
46
20
      my %word_map = ();
446
46
14
37
19
      %word_map = %{$letter_map{$char}{$key}} if defined $letter_map{$char}{$key};
447
46
44
      $word_map{$token} = 1;
448
46
60
      $letter_map{$char}{$key} = \%word_map;
449    }
450
6
18
    close UNKNOWN;
451
6
10
    push @directories, $directory;
452  }
453
9
19
  close SHOULD_EXCLUDE;
454
9
5
  close TIMING_REPORT if $timing_report;
455
456  summarize_totals(
457    sub {
458
0
0
      my ($hits, $files, $context, $pattern) = @_;
459
0
0
      return "# hit-count: $hits$files\n$context$pattern\n\n",
460    },
461
9
28
    CheckSpelling::Util::get_file_from_env('candidate_summary', '/dev/stderr'),
462    \@candidates,
463    \@candidate_totals,
464    \@candidate_file_counts,
465  );
466
467  summarize_totals(
468    sub {
469
1
1
      my (undef, undef, $context, $pattern) = @_;
470
1
2
      $context =~ s/^# //gm;
471
1
1
      chomp $context;
472
1
1
      my $details;
473
1
4
      if ($context =~ /^(.*?)$(.*)/ms) {
474
1
1
        ($context, $details) = ($1, $2);
475
1
3
        $details = "\n$details" if $details;
476      }
477
1
1
      $context = 'Pattern' unless $context;
478
1
6
      return "#### $context$details\n```\n$pattern\n```\n\n";
479    },
480
9
26
    CheckSpelling::Util::get_file_from_env('forbidden_summary', '/dev/stderr'),
481    \@forbidden,
482    \@forbidden_totals,
483  );
484
485
9
27
  group_related_words;
486
487
9
9
  if (defined $ENV{'expect'}) {
488
8
8
    $ENV{'expect'} =~ /(.*)/;
489
8
5
    load_expect $1;
490
8
7
    harmonize_expect;
491  }
492
493
9
7
  my %seen = ();
494
9
3
  our %counters;
495
9
6
  %counters = ();
496
497
9
33
  if (-s $early_warnings) {
498
1
6
    open WARNINGS, '<:utf8', $early_warnings;
499
1
8
    for my $warning (<WARNINGS>) {
500
1
1
      chomp $warning;
501
1
1
      count_warning $warning;
502
1
4
      print WARNING_OUTPUT "$warning\n";
503    }
504
1
4
    close WARNINGS;
505  }
506
507
9
6
  my %last_seen;
508  my %unknown_file_word_count;
509
9
4
  for my $directory (@directories) {
510
8
25
    next unless (-s "$directory/warnings");
511
7
45
    next unless open(NAME, '<:utf8', "$directory/name");
512
7
26
    my $file=<NAME>;
513
7
11
    close NAME;
514
7
7
    my $is_file_list = $file eq $file_list;
515
7
34
    open WARNINGS, '<:utf8', "$directory/warnings";
516
7
8
    if (!$is_file_list) {
517
6
37
      for $warning (<WARNINGS>) {
518
49
35
        chomp $warning;
519
49
85
        if ($warning =~ m/:(\d+):(\d+ \.\.\. \d+): `(.*)`/) {
520
48
39
          my ($line, $range, $item) = ($1, $2, $3);
521
48
39
          my $wrapped = CheckSpelling::Util::wrap_in_backticks($item);
522
48
93
          $warning =~ s/:\d+:\d+ \.\.\. \d+: `.*`/:$line:$range, Warning - $wrapped is not a recognized word\. \(unrecognized-spelling\)/;
523
48
37
          next if log_skip_item($item, $file, $warning, $unknown_word_limit);
524        } else {
525
1
1
          if ($warning =~ /\`(.*?)\` in line\. \(token-is-substring\)/) {
526
0
0
            next if skip_item($1);
527          }
528
1
1
          count_warning $warning;
529        }
530
14
41
        print WARNING_OUTPUT "$file$warning\n";
531      }
532    } else {
533
1
7
      for $warning (<WARNINGS>) {
534
5
8
        chomp $warning;
535
5
10
        next unless $warning =~ s/^:(\d+)/:1/;
536
5
5
        $file = $check_file_paths[$1];
537
5
18
        if ($warning =~ s/:(\d+ \.\.\. \d+): `(.*)`/:$1, Warning - `$2` is not a recognized word\. \(check-file-path\)/) {
538
4
2
          next if skip_item($2);
539
4
2
          if (defined $unknown_file_word_limit) {
540
4
6
            next if ++$unknown_file_word_count{$2} > $unknown_file_word_limit;
541          }
542        }
543
4
13
        print WARNING_OUTPUT "$file$warning\n";
544
4
4
        count_warning $warning;
545      }
546    }
547
7
26
    close WARNINGS;
548  }
549
9
141
  close MORE_WARNINGS;
550
551
9
9
  for my $warning (@delayed_warnings) {
552
1
1
    count_warning $warning;
553
1
2
    print WARNING_OUTPUT $warning;
554  }
555
9
6
  if (defined $unknown_word_limit) {
556
1
2
    for my $warned_word (sort keys %last_seen) {
557
0
0
      my $warning_count = $seen{$warned_word};
558
0
0
      next unless $warning_count >= $unknown_word_limit;
559
0
0
      my $warning = $last_seen{$warned_word};
560
0
0
      $warning =~ s/\Q. (unrecognized-spelling)\E/ -- found $warning_count times. (limited-references)\n/;
561
0
0
      print WARNING_OUTPUT $warning;
562
0
0
      count_warning $warning;
563    }
564  }
565
9
195
  close WARNING_OUTPUT;
566
567
9
10
  if (%counters) {
568
2
3
    my $continue='';
569
2
3
    print COUNTER_SUMMARY "{\n";
570
2
5
    for my $code (sort keys %counters) {
571
4
6
      print COUNTER_SUMMARY qq<$continue"$code": $counters{$code}\n>;
572
4
2
      $continue=',';
573    }
574
2
2
    print COUNTER_SUMMARY "}\n";
575  }
576
9
61
  close COUNTER_SUMMARY;
577
578  # display the current unknown
579
9
23
  for my $char (sort keys %letter_map) {
580
34
34
15
63
    for $key (sort CheckSpelling::Util::case_biased keys(%{$letter_map{$char}})) {
581
29
29
11
35
      my %word_map = %{$letter_map{$char}{$key}};
582
29
26
      my @words = keys(%word_map);
583
29
26
      if (scalar(@words) > 1) {
584
13
19
12
66
        print $key." (".(join ", ", sort { length($a) <=> length($b) || $a cmp $b } @words).")";
585      } else {
586
16
52
        print $words[0];
587      }
588
29
100
      print "\n";
589    }
590  }
591}
592
5931;