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
106615
1
684
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
168
  my ($file, $path) = @_;
24
6
8
  my @path_split = split /\./, $path;
25
6
2
  my $level = 0;
26
6
3
  my @prefixes;
27
6
100
73
  open($yaml, '<', $file) || return '';
28
5
4
  my @result;
29  my $line_result;
30
5
0
  my $mode;
31
5
0
  my $last;
32
5
48
  while (<$yaml>) {
33
521
196
    chomp;
34
521
50
286
    next if /^\s*#/;
35
521
100
50
33
410
    if (/^(\s*)(\S.*)/) {
36
519
295
      my ($prefix, $remainder) = ($1, $2);
37
519
100
646
      while ($level && length $prefix <= length $prefixes[$level - 1]) {
38
2
3
        delete $prefixes[$level--];
39      }
40
519
100
100
278
      if (@result && $level < scalar @path_split) {
41
2
1
        $last = 1;
42
2
2
        last;
43      }
44
517
50
242
      last if $last;
45
517
50
67
536
      if (!$level || length $prefix > length $prefixes[$level - 1]) {
46
517
100
231
        if ($level == scalar @path_split) {
47
5
5
          push @result, $remainder;
48        } else {
49
512
179
          my $next = $path_split[$level];
50
512
100
843
          if ($remainder =~ /$next:(.*)$/) {
51
12
7
            $prefixes[$level++] = $prefix;
52
12
100
12
            if ($level == scalar @path_split) {
53
5
2
              $mode = $1;
54
5
100
50
37
              if ($mode =~ /\s*([-+>|]+)\s*$/) {
55
2
3
                $mode = $1;
56              } elsif ($mode =~ /\s*(\S.*?)\s*$/) {
57
3
4
                my $value = $1;
58
3
3
                $value =~ s/^'(.*)'$/$1/;
59
3
2
                $line_result = $value;
60
3
4
                last;
61              }
62            }
63          }
64        }
65      }
66    } elsif (/^\s*$/ && @result) {
67
2
2
      push @result, '';
68    }
69  }
70
5
19
  close $yaml;
71
5
100
12
  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
1
    $suffix = "\n";
79  } elsif ($newlines =~ /-/) {
80
1
0
    $suffix = ' ';
81  }
82
2
1
  my $empty_lines = 0;
83
2
50
2
  unless ($newlines eq '+') {
84
2
1
    while ($result[$#result] eq '') {
85
1
1
      ++$empty_lines;
86
1
1
      pop @result;
87    }
88  }
89
2
50
2
  if ($mode eq '') {
90
0
0
    return (join ' ', @result).$suffix;
91  }
92
2
100
0
  if ($mode eq '|') {
93
1
4
    return (join "\n", @result).$suffix;
94  }
95
1
50
1
  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
3
      if ($line eq '') {
101
0
0
        push @output, $tentative;
102
0
0
        $tentative = '';
103      } else {
104
3
3
        $tentative .= $suffix . $line;
105      }
106    }
107
1
1
    push @output, $tentative;
108
1
6
    return (join "\n", @output).$suffix;
109  }
110
0
0
  return (join ' ? ', @result).$suffix;
111}
112
113sub check_yaml_key_value {
114
5
5
5
  my ($key, $value, $message, $report_match, $file, $content) = @_;
115
5
2
  my ($state, $gh_yaml_mode) = (0, '');
116
5
3
  my @nests;
117
5
2
  my ($start_line, $start_pod, $end);
118
5
9
  my @lines = split /\n/, $content;
119
5
3
  my $line = 0;
120
5
3
  my @expected_key_path = split /\n/, $key;
121
5
1
  my @current_key_path;
122
5
6
  $key = quotemeta($key);
123
124
5
5
  for (@lines) {
125
65
22
    ++$line;
126
65
100
46
    if (/^(\s*)#/) {
127
5
50
3
      $end += length $_ if ($state == 3);
128
5
2
      next;
129    }
130
60
100
50
32
    if ($state == 0) {
131
56
100
57
      next unless /^(\s*)(-\s+|)(\S+)\s*:/;
132
37
36
      my ($spaces, $array_element, $record) = ($1, $2, $3);
133
37
15
      my $len = length "$spaces$array_element";
134
37
100
47
      while (scalar @nests && $len < $nests[$#nests]) {
135
8
10
        pop @nests;
136      }
137
37
100
100
68
      push @nests, $len if (! scalar @nests || $len > $nests[$#nests]);
138
37
100
22
      if ($#expected_key_path >= 1) {
139
10
4
        $#current_key_path = $#nests;
140
10
7
        $current_key_path[$#nests] = $record;
141
10
100
7
        next if $#nests != $#expected_key_path;
142
4
3
        my $unequal = 0;
143
4
2
        for my $i (0 .. $#nests) {
144
9
100
7
          if ($current_key_path[$i] ne $expected_key_path[$i]) {
145
3
0
            $unequal = 1;
146
3
1
            last;
147          }
148        }
149
4
100
5
        next if $unequal;
150
1
1
        $key = quotemeta($expected_key_path[$#nests]);
151      }
152
28
100
263
      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
37
        report($file, $start_line, $start_pos, $end, $message, $match, $report_match) if ($gh_yaml_mode =~ /$value|\$\{\{/);
156
4
100
1512
        if ($report_match) {
157
2
3
          $_ =~ /^\s*(.*)/;
158
2
1
          $match = "$_\n";
159        } else {
160
2
1
          $match = "$key: ";
161        }
162
4
4
        $state = 1;
163      }
164    } elsif ($state == 1) {
165
4
50
7
      if (/^\s*(?:#.*|)$/) {
166
0
0
        $end += length $_;
167
0
0
        next;
168      }
169
4
4
      /^(\s*)(\S.*?)\s*$/;
170
4
9
      my ($spaces, $v) = ($1, $2);
171
4
3
      $len = length $spaces;
172
4
100
50
18
      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
0
          $match .= $v;
178        }
179
3
4
        report($file, $start_line, $start_pos, $end, $message, $match, $report_match);
180      }
181
4
4466
      pop @nests;
182
4
5
      $state = 0;
183    }
184  }
185}
186
1871;