File Coverage

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

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