File Coverage

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

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