File Coverage

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

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