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
108751
3
29
use warnings;
7
1
1
1
2
1
29
use File::Path qw(remove_tree);
8
1
1
1
275
1
2133
use CheckSpelling::Util;
9
10my %letter_map;
11my %ignored_event_map;
12my $disable_word_collating;
13
14sub get_field {
15
28
20
  my ($record, $field) = @_;
16
28
318
  return 0 unless $record =~ (/\b$field:\s*(\d+)/);
17
16
19
  return $1;
18}
19
20sub get_array {
21
2
3
  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
11
  $next = $value unless $next && $next < $value;
30
7
2
  return $next;
31}
32
33my %expected = ();
34sub expect_item {
35
98
60
  my ($item, $value) = @_;
36
98
44
  our %expected;
37
98
39
  my $next;
38
98
98
  if (defined $expected{$item}) {
39
26
11
    $next = $expected{$item};
40
26
22
    $next = $value if $value < $next;
41  } elsif ($item =~ /^([A-Z])(.*)/) {
42
12
9
    $item = $1 . lc $2;
43
12
6
    if (defined $expected{$item}) {
44
2
1
      $next = $expected{$item};
45
2
5
      $next = maybe($next, $value + .1);
46    } else {
47
10
6
      $item = lc $item;
48
10
10
      if (defined $expected{$item}) {
49
5
2
        $next = $expected{$item};
50
5
4
        $next = maybe($next, $value + .2);
51      }
52    }
53  }
54
98
88
  return 0 unless defined $next;
55
33
19
  $expected{$item} = $next;
56
33
62
  return $value;
57}
58
59sub skip_item {
60
52
28
  my ($word) = @_;
61
52
34
  return 1 if expect_item($word, 1);
62
32
20
  my $key = lc $word;
63
32
18
  return 2 if expect_item($key, 2);
64
32
38
  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
3
    $key = $1;
74  } else {
75
23
23
    return 0;
76  }
77
9
6
  return 3 if expect_item($key, 3);
78
0
0
  return 0;
79}
80
81sub log_skip_item {
82
48
71
  my ($item, $file, $warning, $unknown_word_limit) = @_;
83
48
34
  return 1 if skip_item($item);
84
19
10
  my $seen_count = $seen{$item};
85
19
13
  if (defined $seen_count) {
86
6
9
    if (!defined $unknown_word_limit || ($seen_count++ < $unknown_word_limit)) {
87
5
25
      print MORE_WARNINGS "$file$warning\n"
88    } else {
89
1
2
      $last_seen{$item} = "$file$warning";
90    }
91
6
4
    $seen{$item} = $seen_count;
92
6
11
    return 1;
93  }
94
13
13
  $seen{$item} = 1;
95
13
14
  return 0;
96}
97
98sub stem_word {
99
22
7
  my ($key) = @_;
100
22
12
  our $disable_word_collating;
101
22
13
  return $key if $disable_word_collating;
102
103
22
26
  if ($key =~ /.s$/) {
104
3
3
    if ($key =~ /ies$/) {
105
1
1
      $key =~ s/ies$/y/;
106    } else {
107
2
3
      $key =~ s/s$//;
108    }
109  } elsif ($key =~ /.[^aeiou]ed$/) {
110
1
2
    $key =~ s/ed$//;
111  }
112
22
11
  return $key;
113}
114
115sub collate_key {
116
77
42
  my ($key) = @_;
117
77
37
  our $disable_word_collating;
118
77
39
  if ($disable_word_collating) {
119
16
15
    $char = lc substr $key, 0, 1;
120  } else {
121
61
45
    $key = lc $key;
122
61
38
    $key =~ s/''+/'/g;
123
61
33
    $key =~ s/'[sd]$//;
124
61
30
    $key =~ s/^[^Ii]?'+(.*)/$1/;
125
61
29
    $key =~ s/(.*?)'$/$1/;
126
61
50
    $char = substr $key, 0, 1;
127  }
128
77
86
  return ($key, $char);
129}
130
131sub load_expect {
132
9
459
  my ($expect) = @_;
133
9
6
  our %expected;
134
9
9
  %expected = ();
135
9
70
  if (open(EXPECT, '<:utf8', $expect)) {
136
9
69
    while ($word = <EXPECT>) {
137
34
50
      $word =~ s/\R//;
138
34
61
      $expected{$word} = 0;
139    }
140
9
28
    close EXPECT;
141  }
142}
143
144sub harmonize_expect {
145
8
4
  our $disable_word_collating;
146
8
3
  our %letter_map;
147
8
4
  our %expected;
148
149
8
11
  for my $word (keys %expected) {
150
31
14
    my ($key, $char) = collate_key $word;
151
31
20
    my %word_map = ();
152
31
50
    next unless defined $letter_map{$char}{$key};
153
15
15
6
17
    %word_map = %{$letter_map{$char}{$key}};
154
15
17
    next if defined $word_map{$word};
155
3
2
    my $words = scalar keys %word_map;
156
3
2
    next if $words > 2;
157
3
3
    if ($word eq $key) {
158
1
1
      next if ($words > 1);
159    }
160
2
3
    delete $expected{$word};
161  }
162}
163
164sub group_related_words {
165
9
4
  our %letter_map;
166
9
3
  our $disable_word_collating;
167
9
6
  return if $disable_word_collating;
168
169  # group related words
170
7
16
  for my $char (sort CheckSpelling::Util::number_biased keys %letter_map) {
171
19
19
13
12
    for my $plural_key (sort keys(%{$letter_map{$char}})) {
172
22
17
      my $key = stem_word $plural_key;
173
22
21
      next if $key eq $plural_key;
174
4
4
      next unless defined $letter_map{$char}{$key};
175
3
3
2
3
      my %word_map = %{$letter_map{$char}{$key}};
176
3
3
2
2
      for $word (keys(%{$letter_map{$char}{$plural_key}})) {
177
3
3
        $word_map{$word} = 1;
178      }
179
3
4
      $letter_map{$char}{$key} = \%word_map;
180
3
3
      delete $letter_map{$char}{$plural_key};
181    }
182  }
183}
184
185sub count_warning {
186
10
9
  my ($warning) = @_;
187
10
5
  our %counters;
188
10
4
  our %ignored_event_map;
189
10
19
  if ($warning =~ /\(([-\w]+)\)$/) {
190
8
5
    my ($code) = ($1);
191
8
20
    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
10
  my ($path) = @_;
205
18
23
  return unless defined $ENV{$path};
206
9
9
  $ENV{$path} =~ /(.*)/;
207
9
52
  return unless open ITEMS, '<:utf8', $1;
208
209
9
4
  my @items;
210
9
6
  my $context = '';
211
9
46
  while (<ITEMS>) {
212
2
2
    my $pattern = $_;
213
2
3
    if ($pattern =~ /^#/) {
214
1
2
      if ($pattern =~ /^# /) {
215
1
2
        $context .= $pattern;
216      } else {
217
0
0
        $context = '';
218      }
219
1
2
      next;
220    }
221
1
1
    chomp $pattern;
222
1
1
    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
23
  close ITEMS;
230
9
10
  return @items;
231}
232
233sub summarize_totals {
234
18
14
  my ($formatter, $path, $items, $totals, $file_counts) = @_;
235
18
18
9
17
  return unless @{$totals};
236
1
19
  return unless open my $fh, '>:utf8', $path;
237
1
1
1
0
  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
2
  for my $i (@indices) {
250
1
5
    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
2
      ($description, $rule) = ($1, $2);
255    } else {
256
0
0
      ($description, $rule) = ('', $rule_with_context);
257    }
258
1
1
    print $fh $formatter->(
259      $totals->[$i],
260      ($file_counts ? " file-count: $file_counts->[$i]" : ""),
261      $description,
262      $rule
263    );
264  }
265
1
31
  close $fh;
266}
267
268sub main {
269
9
15686
  my @directories;
270  my @cleanup_directories;
271
9
0
  my @check_file_paths;
272
273
9
10
  my $early_warnings = CheckSpelling::Util::get_file_from_env('early_warnings', '/dev/null');
274
9
8
  my $warning_output = CheckSpelling::Util::get_file_from_env('warning_output', '/dev/stderr');
275
9
7
  my $more_warnings = CheckSpelling::Util::get_file_from_env('more_warnings', '/dev/stderr');
276
9
5
  my $counter_summary = CheckSpelling::Util::get_file_from_env('counter_summary', '/dev/stderr');
277
9
7
  my $ignored_events = CheckSpelling::Util::get_file_from_env('ignored_events', '');
278
9
11
  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
6
  my $should_exclude_file = CheckSpelling::Util::get_file_from_env('should_exclude_file', '/dev/null');
285
9
5
  my $unknown_word_limit = CheckSpelling::Util::get_val_from_env('unknown_word_limit', undef);
286
9
8
  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
6
  my $disable_flags = CheckSpelling::Util::get_file_from_env('INPUT_DISABLE_CHECKS', '');
289
9
6
  my $only_check_changed_files = CheckSpelling::Util::get_file_from_env('INPUT_ONLY_CHECK_CHANGED_FILES', '');
290
9
4
  my $disable_noisy_file = $disable_flags =~ /(?:^|,|\s)noisy-file(?:,|\s|$)/;
291
9
30
  our $disable_word_collating = $only_check_changed_files || $disable_flags =~ /(?:^|,|\s)word-collating(?:,|\s|$)/;
292
9
5
  my $file_list = CheckSpelling::Util::get_file_from_env('check_file_names', '');
293
9
7
  my $timing_report = CheckSpelling::Util::get_file_from_env('timing_report', '');
294
9
6
  my ($start_time, $end_time);
295
296
9
181
  open WARNING_OUTPUT, '>:utf8', $warning_output;
297
9
145
  open MORE_WARNINGS, '>:utf8', $more_warnings;
298
9
111
  open COUNTER_SUMMARY, '>:utf8', $counter_summary;
299
9
64
  open SHOULD_EXCLUDE, '>:utf8', $should_exclude_file;
300
9
8
  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
9
  my @candidates = get_pattern_with_context('candidates_path');
306
9
5
  my @candidate_totals = (0) x scalar @candidates;
307
9
5
  my @candidate_file_counts = (0) x scalar @candidates;
308
309
9
5
  my @forbidden = get_pattern_with_context('forbidden_path');
310
9
8
  my @forbidden_totals = (0) x scalar @forbidden;
311
312
9
4
  my @delayed_warnings;
313
9
18
  our %letter_map = ();
314
315
9
3
  my %file_map = ();
316
317
9
21
  for my $directory (<>) {
318
12
12
    chomp $directory;
319
12
20
    next unless $directory =~ /^(.*)$/;
320
12
11
    $directory = $1;
321
12
35
    unless (-e $directory) {
322
1
3
      print STDERR "Could not find: $directory\n";
323
1
1
      next;
324    }
325
11
24
    unless (-d $directory) {
326
1
10
      print STDERR "Not a directory: $directory\n";
327
1
1
      next;
328    }
329
330    # if there's no filename, we can't report
331
10
72
    next unless open(NAME, '<:utf8', "$directory/name");
332
9
43
    my $file=<NAME>;
333
9
16
    close NAME;
334
335
9
20
    $file_map{$file} = $directory;
336  }
337
338
9
16
  for my $file (sort keys %file_map) {
339
9
7
    my $directory = $file_map{$file};
340
9
8
    if ($timing_report) {
341
0
0
      $start_time = (stat "$directory/name")[9];
342    }
343
344
9
42
    if (-e "$directory/skipped") {
345
1
6
      open SKIPPED, '<:utf8', "$directory/skipped";
346
1
6
      my $reason=<SKIPPED>;
347
1
2
      close SKIPPED;
348
1
1
      chomp $reason;
349
1
9
      push @delayed_warnings, "$file:1:1 ... 1, Warning - Skipping `$file` because $reason\n";
350
1
4
      print SHOULD_EXCLUDE "$file\n";
351
1
1
      push @cleanup_directories, $directory;
352
1
1
      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
21
    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
8
    if ($file eq $file_list) {
364
1
5
      open FILE_LIST, '<:utf8', $file_list;
365
1
1
      push @check_file_paths, '0 placeholder';
366
1
6
      for my $check_file_path (<FILE_LIST>) {
367
4
2
        chomp $check_file_path;
368
4
4
        push @check_file_paths, $check_file_path;
369      }
370
1
3
      close FILE_LIST;
371    }
372
373
7
5
    my ($words, $unrecognized, $unknown, $unique);
374
375    {
376
7
7
2
37
      open STATS, '<:utf8', "$directory/stats";
377
7
25
      my $stats=<STATS>;
378
7
12
      close STATS;
379
7
6
      $words=get_field($stats, 'words');
380
7
7
      $unrecognized=get_field($stats, 'unrecognized');
381
7
6
      $unknown=get_field($stats, 'unknown');
382
7
4
      $unique=get_field($stats, 'unique');
383
7
2
      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
7
      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
6
    report_timing($file, $start_time, $directory, 'unknown') if ($timing_report);
419    # These heuristics are very new and need tuning/feedback
420
7
6
    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
26
    unless (-s "$directory/unknown") {
436
1
1
      push @directories, $directory;
437
1
2
      next;
438    }
439
6
40
    open UNKNOWN, '<:utf8', "$directory/unknown";
440
6
38
    for $token (<UNKNOWN>) {
441
49
50
      $token =~ s/\R//;
442
49
46
      next unless $token =~ /./;
443
46
44
      my ($key, $char) = collate_key $token;
444
46
54
      $letter_map{$char} = () unless defined $letter_map{$char};
445
46
21
      my %word_map = ();
446
46
14
40
18
      %word_map = %{$letter_map{$char}{$key}} if defined $letter_map{$char}{$key};
447
46
47
      $word_map{$token} = 1;
448
46
60
      $letter_map{$char}{$key} = \%word_map;
449    }
450
6
21
    close UNKNOWN;
451
6
8
    push @directories, $directory;
452  }
453
9
19
  close SHOULD_EXCLUDE;
454
9
9
  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
21
    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
6
      if ($context =~ /^(.*?)$(.*)/ms) {
474
1
1
        ($context, $details) = ($1, $2);
475
1
1
        $details = "\n$details" if $details;
476      }
477
1
1
      $context = 'Pattern' unless $context;
478
1
5
      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
25
  group_related_words;
486
487
9
10
  if (defined $ENV{'expect'}) {
488
8
7
    $ENV{'expect'} =~ /(.*)/;
489
8
8
    load_expect $1;
490
8
6
    harmonize_expect;
491  }
492
493
9
6
  my %seen = ();
494
9
5
  our %counters;
495
9
4
  %counters = ();
496
497
9
32
  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
5
      print WARNING_OUTPUT "$warning\n";
503    }
504
1
2
    close WARNINGS;
505  }
506
507
9
4
  my %last_seen;
508  my %unknown_file_word_count;
509
9
6
  for my $directory (@directories) {
510
8
25
    next unless (-s "$directory/warnings");
511
7
44
    next unless open(NAME, '<:utf8', "$directory/name");
512
7
25
    my $file=<NAME>;
513
7
14
    close NAME;
514
7
5
    my $is_file_list = $file eq $file_list;
515
7
34
    open WARNINGS, '<:utf8', "$directory/warnings";
516
7
6
    if (!$is_file_list) {
517
6
37
      for $warning (<WARNINGS>) {
518
49
33
        chomp $warning;
519
49
86
        if ($warning =~ m/:(\d+):(\d+ \.\.\. \d+): `(.*)`/) {
520
48
47
          my ($line, $range, $item) = ($1, $2, $3);
521
48
31
          my $wrapped = CheckSpelling::Util::wrap_in_backticks($item);
522
48
106
          $warning =~ s/:\d+:\d+ \.\.\. \d+: `.*`/:$line:$range, Warning - $wrapped is not a recognized word\. \(unrecognized-spelling\)/;
523
48
24
          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
8
      for $warning (<WARNINGS>) {
534
5
3
        chomp $warning;
535
5
14
        next unless $warning =~ s/^:(\d+)/:1/;
536
5
5
        $file = $check_file_paths[$1];
537
5
19
        if ($warning =~ s/:(\d+ \.\.\. \d+): `(.*)`/:$1, Warning - `$2` is not a recognized word\. \(check-file-path\)/) {
538
4
1
          next if skip_item($2);
539
4
3
          if (defined $unknown_file_word_limit) {
540
4
3
            next if ++$unknown_file_word_count{$2} > $unknown_file_word_limit;
541          }
542        }
543
4
17
        print WARNING_OUTPUT "$file$warning\n";
544
4
4
        count_warning $warning;
545      }
546    }
547
7
27
    close WARNINGS;
548  }
549
9
131
  close MORE_WARNINGS;
550
551
9
7
  for my $warning (@delayed_warnings) {
552
1
1
    count_warning $warning;
553
1
1
    print WARNING_OUTPUT $warning;
554  }
555
9
7
  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
181
  close WARNING_OUTPUT;
566
567
9
9
  if (%counters) {
568
2
1
    my $continue='';
569
2
4
    print COUNTER_SUMMARY "{\n";
570
2
4
    for my $code (sort keys %counters) {
571
4
6
      print COUNTER_SUMMARY qq<$continue"$code": $counters{$code}\n>;
572
4
3
      $continue=',';
573    }
574
2
2
    print COUNTER_SUMMARY "}\n";
575  }
576
9
58
  close COUNTER_SUMMARY;
577
578  # display the current unknown
579
9
23
  for my $char (sort keys %letter_map) {
580
34
34
37
66
    for $key (sort CheckSpelling::Util::case_biased keys(%{$letter_map{$char}})) {
581
29
29
19
31
      my %word_map = %{$letter_map{$char}{$key}};
582
29
22
      my @words = keys(%word_map);
583
29
48
      if (scalar(@words) > 1) {
584
13
21
12
69
        print $key." (".(join ", ", sort { length($a) <=> length($b) || $a cmp $b } @words).")";
585      } else {
586
16
52
        print $words[0];
587      }
588
29
98
      print "\n";
589    }
590  }
591}
592
5931;