File Coverage

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

linestmtbrancondsubtimecode
1#! -*-perl-*-
2
3package CheckSpelling::Exclude;
4
5our $VERSION='0.1.0';
6
2
2
2
2
104224
0
341
use CheckSpelling::Util;
7
8# This script takes null delimited files as input
9# it drops paths that match the listed exclusions
10# output is null delimited to match input
11
12sub file_to_re {
13
7
7
831
  my ($file, $fallback) = @_;
14
7
3
  my @items;
15
7
100
100
36
  if (defined $file && -e $file) {
16
4
29
    open FILE, '<:utf8', $file;
17
4
7
    local $/=undef;
18
4
16
    my $file=<FILE>;
19
4
12
    for (split /\R/, $file) {
20
13
100
19
      next if /^(?:#|$)/;
21
8
24
      s/^\s*(.*)\s*$/(?:$1)/;
22
8
1
11
1
      s/\\Q(.*?)\\E/quotemeta($1)/eg;
23
8
11
      push @items, $_;
24    }
25  }
26
7
100
12
  my $pattern = scalar @items ? join "|", @items : $fallback;
27
7
12
  return $pattern;
28}
29
30sub main {
31
2
2
881
  my $exclude_file = CheckSpelling::Util::get_file_from_env('exclude_file', undef);
32
2
2
  my $only_file = CheckSpelling::Util::get_file_from_env('only_file', undef);
33
34
2
2
  my $exclude = file_to_re($exclude_file, '^$');
35
2
2
  my $only = file_to_re($only_file, '.');
36
37
2
2
  $/="\0";
38
2
3
  while (<>) {
39
5
6
    chomp;
40
5
100
19
    next if m{$exclude};
41
4
100
36
    next unless m{$only};
42
2
9
    print "$_$/";
43  }
44}
45
461;