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
107966
2
389
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
928
  my ($file, $fallback) = @_;
14
7
1
  my @items;
15
7
100
100
46
  if (defined $file && -e $file) {
16
4
41
    open FILE, '<:utf8', $file;
17
4
5
    local $/=undef;
18
4
26
    my $file=<FILE>;
19
4
14
    for (split /\R/, $file) {
20
13
100
21
      next if /^(?:#|$)/;
21
8
23
      s/^\s*(.*)\s*$/(?:$1)/;
22
8
1
11
2
      s/\\Q(.*?)\\E/quotemeta($1)/eg;
23
8
10
      push @items, $_;
24    }
25  }
26
7
100
15
  my $pattern = scalar @items ? join "|", @items : $fallback;
27
7
12
  return $pattern;
28}
29
30sub main {
31
2
2
945
  my $exclude_file = CheckSpelling::Util::get_file_from_env('exclude_file', undef);
32
2
3
  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
5
  while (<>) {
39
5
3
    chomp;
40
5
100
19
    next if m{$exclude};
41
4
100
13
    next unless m{$only};
42
2
7
    print "$_$/";
43  }
44}
45
461;