File Coverage

File:lib/CheckSpelling/Yaml.pm
Coverage:89.2%

linestmtbrancondsubtimecode
1#! -*-perl-*-
2
3package CheckSpelling::Yaml;
4
5our $VERSION='0.1.0';
6
1
1
1
1
103979
1
665
use CheckSpelling::Util;
7
8sub report {
9  my ($file, $start_line, $start_pos, $end, $message, $match, $report_match) = @_;
10  open(my $output, '>>', CheckSpelling::Util::get_file_from_env('output', '/dev/null'));
11  if (1 == $report_match) {
12    print "$match";
13    print $output "$match";
14  } else {
15    print "$file:$start_line:$start_pos ... $end, $message\n";
16    print $output "$file:$start_line:$start_pos ... $end, $message\n";
17  }
18  close $output;
19  exit;
20}
21
22sub get_yaml_value {
23
6
6
169
  my ($file, $path) = @_;
24
6
10
  my @path_split = split /\./, $path;
25
6
5
  my $level = 0;
26
6
5
  my @prefixes;
27
6
100
107
  open($yaml, '<', $file) || return '';
28
5
8
  my @result;
29  my $line_result;
30
5
0
  my $mode;
31
5
0
  my $last;
32
5
51
  while (<$yaml>) {
33
518
197
    chomp;
34
518
50
286
    next if /^\s*#/;
35
518
100
50
33
426
    if (/^(\s*)(\S.*)/) {
36
516
310
      my ($prefix, $remainder) = ($1, $2);
37
516
100
607
      while ($level && length $prefix <= length $prefixes[$level - 1]) {
38
2
3
        delete $prefixes[$level--];
39      }
40
516
100
100
286
      if (@result && $level < scalar @path_split) {
41
2
1
        $last = 1;
42
2
2
        last;
43      }
44
514
50
238
      last if $last;
45
514
50
67
547
      if (!$level || length $prefix > length $prefixes[$level - 1]) {
46
514
100
226
        if ($level == scalar @path_split) {
47
5
7
          push @result, $remainder;
48        } else {
49
509
183
          my $next = $path_split[$level];
50
509
100
859
          if ($remainder =~ /$next:(.*)$/) {
51
12
8
            $prefixes[$level++] = $prefix;
52
12
100
14
            if ($level == scalar @path_split) {
53
5
2
              $mode = $1;
54
5
100
50
13
              if ($mode =~ /\s*([-+>|]+)\s*$/) {
55
2
2
                $mode = $1;
56              } elsif ($mode =~ /\s*(\S.*?)\s*$/) {
57
3
3
                my $value = $1;
58
3
1
                $value =~ s/^'(.*)'$/$1/;
59
3
2
                $line_result = $value;
60
3
3
                last;
61              }
62            }
63          }
64        }
65      }
66    } elsif (/^\s*$/ && @result) {
67
2
2
      push @result, '';
68    }
69  }
70
5
20
  close $yaml;
71
5
100
10
  return $line_result unless @result;
72
2
2
  my $newlines = '';
73
2
100
3
  $newlines = $1 if $mode =~ /([-+])/;
74
2
1
  $mode =~ /([|>]?)/;
75
2
2
  $mode = $1;
76
2
0
  my $suffix = '';
77
2
100
50
3
  if ($newlines eq '') {
78
1
3
    $suffix = "\n";
79  } elsif ($newlines =~ /-/) {
80
1
0
    $suffix = ' ';
81  }
82
2
2
  my $empty_lines = 0;
83
2
50
0
  unless ($newlines eq '+') {
84
2
2
    while ($result[$#result] eq '') {
85
1
1
      ++$empty_lines;
86
1
1
      pop @result;
87    }
88  }
89
2
50
1
  if ($mode eq '') {
90
0
0
    return (join ' ', @result).$suffix;
91  }
92
2
100
2
  if ($mode eq '|') {
93
1
3
    return (join "\n", @result).$suffix;
94  }
95
1
50
0
  if ($mode eq '>') {
96
1
1
    my @output;
97    my $tentative;
98
1
0
    while (@result) {
99
3
1
      my $line = shift @result;
100
3
50
2
      if ($line eq '') {
101
0
0
        push @output, $tentative;
102
0
0
        $tentative = '';
103      } else {
104
3
4
        $tentative .= $suffix . $line;
105      }
106    }
107
1
1
    push @output, $tentative;
108
1
5
    return (join "\n", @output).$suffix;
109  }
110
0
0
  return (join ' ? ', @result).$suffix;
111}
112
113sub check_yaml_key_value {
114
5
5
9
  my ($key, $value, $message, $report_match, $file, $content) = @_;
115
5
6
  my ($state, $gh_yaml_mode) = (0, '');
116
5
4
  my @nests;
117
5
4
  my ($start_line, $start_pod, $end);
118
5
12
  my @lines = split /\n/, $content;
119
5
5
  my $line = 0;
120
5
5
  my @expected_key_path = split /\n/, $key;
121
5
2
  my @current_key_path;
122
5
5
  $key = quotemeta($key);
123
124
5
5
  for (@lines) {
125
65
28
    ++$line;
126
65
100
61
    if (/^(\s*)#/) {
127
5
50
2
      $end += length $_ if ($state == 3);
128
5
4
      next;
129    }
130
60
100
50
40
    if ($state == 0) {
131
56
100
76
      next unless /^(\s*)(-\s+|)(\S+)\s*:/;
132
37
40
      my ($spaces, $array_element, $record) = ($1, $2, $3);
133
37
23
      my $len = length "$spaces$array_element";
134
37
100
47
      while (scalar @nests && $len < $nests[$#nests]) {
135
8
11
        pop @nests;
136      }
137
37
100
100
58
      push @nests, $len if (! scalar @nests || $len > $nests[$#nests]);
138
37
100
27
      if ($#expected_key_path >= 1) {
139
10
4
        $#current_key_path = $#nests;
140
10
7
        $current_key_path[$#nests] = $record;
141
10
100
8
        next if $#nests != $#expected_key_path;
142
4
2
        my $unequal = 0;
143
4
3
        for my $i (0 .. $#nests) {
144
9
100
6
          if ($current_key_path[$i] ne $expected_key_path[$i]) {
145
3
2
            $unequal = 1;
146
3
0
            last;
147          }
148        }
149
4
100
5
        next if $unequal;
150
1
1
        $key = quotemeta($expected_key_path[$#nests]);
151      }
152
28
100
300
      if (/^\s*(($key)\s*:\s*([|>](?:[-+]\d*)?|\$\{\{.*|(?:"\s*|)$value))\s*$/) {
153
4
3
        $gh_yaml_mode = $3;
154
4
8
        ($start_line, $start_pos, $end, $match) = ($line, $-[2] + 1, $+[3] + 1, $1);
155
4
100
39
        report($file, $start_line, $start_pos, $end, $message, $match, $report_match) if ($gh_yaml_mode =~ /$value|\$\{\{/);
156
4
100
1867
        if ($report_match) {
157
2
4
          $_ =~ /^\s*(.*)/;
158
2
1
          $match = "$_\n";
159        } else {
160
2
2
          $match = "$key: ";
161        }
162
4
5
        $state = 1;
163      }
164    } elsif ($state == 1) {
165
4
50
5
      if (/^\s*(?:#.*|)$/) {
166
0
0
        $end += length $_;
167
0
0
        next;
168      }
169
4
7
      /^(\s*)(\S.*?)\s*$/;
170
4
10
      my ($spaces, $v) = ($1, $2);
171
4
4
      $len = length $spaces;
172
4
100
50
21
      if (scalar @nests && $len > $nests[$#nests] && $v =~ /$value/) {
173
3
1
        $end += $len + length $v;
174
3
100
3
        if ($report_match) {
175
1
1
          $match .= $_;
176        } else {
177
2
2
          $match .= $v;
178        }
179
3
3
        report($file, $start_line, $start_pos, $end, $message, $match, $report_match);
180      }
181
4
5520
      pop @nests;
182
4
8
      $state = 0;
183    }
184  }
185}
186
1871;