File Coverage

File:lib/CheckSpelling/CleanupFiles.pm
Coverage:99.4%

linestmtbrancondsubtimecode
1#! -*-perl-*-
2
3package CheckSpelling::CleanupFiles;
4
5
1
1
1
1
112045
1
23
use Cwd 'realpath';
6
1
1
1
1
2
0
10
use File::Spec;
7
1
1
1
1
172
1
17
use CheckSpelling::Util;
8
1
1
1
1
232
1
15
use CheckSpelling::CheckDictionary;
9
1
1
1
1
158
1
13
use CheckSpelling::CheckPattern;
10
1
1
1
1
238
1
16
use CheckSpelling::EnglishList;
11
1
1
1
1
1
3
488
use Cwd qw(abs_path);
12
13sub identity {
14
13
13
6
  my ($line) = @_;
15
13
9
  return ($line, '');
16}
17
18sub call_check_line {
19
32
32
18
  my ($line) = @_;
20
32
8
  my $warning;
21
32
13
  our ($check_line, $output_fh, $warnings_fh);
22
32
18
  ($line, $warning) = $check_line->($line);
23
32
100
27
  if ($warning ne '') {
24
4
8
    print $warnings_fh "$ARGV:$.:$warning";
25  }
26
32
67
  print $output_fh $line."\n";
27}
28
29sub maybe_log_event {
30
7
7
4
  my ($handle, $message, $code) = @_;
31
7
50
6
  print $handle "$message ($code)\n" unless CheckSpelling::Util::is_ignoring_event($code);
32}
33
34sub clean_files {
35
8
8
10671
  my @files = @_;
36
8
8
  CheckSpelling::Util::build_ignored_event_map();
37
8
8
  CheckSpelling::CheckPattern::reset_seen();
38
8
4
  my $type=CheckSpelling::Util::get_file_from_env('type');
39
8
6
  my $output=CheckSpelling::Util::get_file_from_env('output', '/dev/null');
40
8
3
  my $workspace_path=abs_path(CheckSpelling::Util::get_file_from_env('GITHUB_WORKSPACE', '.'));
41
8
6
  my $used_config_files=CheckSpelling::Util::get_file_from_env('used_config_files', '/dev/null');
42
8
23
  $ENV{comment_char}='\s*#';
43
1
1
1
8
1
2
1
1
7
  open our $warnings_fh, '>>:encoding(UTF-8)', CheckSpelling::Util::get_file_from_env('early_warnings', '/dev/null');
44
8
20406
  open our $output_fh, '>>:encoding(UTF-8)', $output;
45
8
226
  open my $used_config_files_fh, '>>:encoding(UTF-8)', $used_config_files;
46
8
121
  my $old_file;
47
8
5
  our $check_line;
48
49
8
100
100
17
  if ($type =~ /^(?:line_forbidden|patterns|excludes|only|reject)$/) {
50
1
1
    $check_line = \&CheckSpelling::CheckPattern::process_line;
51  } elsif ($type =~ /^(?:dictionary|expect|allow)$/) {
52
1
1
    $check_line = \&CheckSpelling::CheckDictionary::process_line;
53  } else {
54
6
5
    $check_line = \&identity;
55  }
56
57
8
5
  for my $file (@files) {
58
13
210
    my $maybe_bad=abs_path($file);
59
13
100
44
    if ($maybe_bad !~ /^\Q$workspace_path\E/) {
60
1
17
      print "::error ::Configuration files must live within $workspace_path...\n";
61
1
3
      print "::error ::Unfortunately, file '$file' appears to reside elsewhere.\n";
62
1
9
      return 3;
63    }
64
12
100
13
    if ($maybe_bad =~ m{/\.git/}i) {
65
1
13
      print "::error ::Configuration files must not live within `.git/`...\n";
66
1
3
      print "::error ::Unfortunately, file '$file' appears to.\n";
67
1
9
      return 4;
68    }
69
11
7
    my $fh;
70
11
100
91
    if (open($fh, '<:encoding(UTF-8)', $file)) {
71
10
163
      $ARGV = $file;
72
10
17
      print $used_config_files_fh "$file\0";
73
10
17
      seek($fh, -1, 2);
74
10
84
      read($fh, $buffer, 1);
75
10
25
      my $length = tell($fh);
76
10
16
      seek($fh, 0, 0);
77
10
6
      my $add_nl_at_eof = 0;
78
10
100
6
      if ($length == 0) {
79
3
4
        maybe_log_event(STDERR, "$file:1:1 ... 1, Notice - File is empty", 'empty-file');
80      } else {
81
7
100
11
        if ($buffer !~ /\R/) {
82
1
0
          $add_nl_at_eof = 1;
83        }
84        # local $/ = undef;
85
7
7
        my ($nl, $first_end, $end, $line);
86
7
0
        my %eol_counts;
87
7
4
        my $content = '';
88
7
22
        while (!eof($fh)) {
89
7
34
          read $fh, $buffer, 4096;
90
7
6
          $content .= $buffer;
91
7
16
          while ($content =~ s/([^\r\n\x0b\f\x85\x{2028}\x{2029}]*)(\r\n|\n|\r|\x0b|\f|\x85|\x{2028}|\x{2029})//m) {
92
31
23
            ++$.;
93
31
22
            my ($line, $end) = ($1, $2);
94
31
100
100
24
            unless (defined $nl) {
95
7
5
              $nl = $end;
96            } elsif ($end ne $nl) {
97              maybe_log_event($warnings_fh, "$file:$.:$-[0] ... $+[0], Warning - Entry has inconsistent line endings", 'unexpected-line-ending');
98            }
99
31
18
            ++$eol_counts{$end};
100
31
15
            my $warning;
101
31
14
            call_check_line($line);
102          }
103        }
104
7
100
5
        if ($content ne '') {
105
1
1
          call_check_line($content);
106        }
107
7
100
5
        if ($add_nl_at_eof) {
108
1
1
          my $line_length = length $_;
109
1
2
          maybe_log_event(STDERR, "$file:$.:1 ... $length, Warning - Missing newline at end of file", 'no-newline-at-eof');
110
1
2
          print $output_fh "\n";
111        }
112
7
100
10
        my $eol_a = $eol_counts{"\n"} || 0;
113
7
100
12
        my $eol_d = $eol_counts{"\r"} || 0;
114
7
100
29
        my $eol_d_a = $eol_counts{"\r\n"} || 0;
115
7
4
        my @line_endings;
116
7
100
6
        push @line_endings, "DOS [$eol_d_a]" if $eol_d_a;
117
7
100
6
        push @line_endings, "UNIX [$eol_a]" if $eol_a;
118
7
100
6
        push @line_endings, "Mac classic [$eol_d]" if $eol_d;
119
7
100
11
        if (scalar @line_endings > 1) {
120
1
1
          my $line_length = length $_;
121
1
1
          my $mixed_endings = CheckSpelling::EnglishList::build(@line_endings);
122
1
2
          maybe_log_event(STDERR, "$file:$.:1 ... $length, Warning - Mixed $mixed_endings line endings", 'mixed-line-endings');
123        }
124      }
125
10
55
      close($fh);
126    }
127  }
128
6
35
  close $used_config_files_fh;
129
6
80
  close $output_fh;
130
6
24
  close $warnings_fh;
131
6
12
  return 0;
132}
133
1341;