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
105399
1
658
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
184
  my ($file, $path) = @_;
24
6
6
  my @path_split = split /\./, $path;
25
6
2
  my $level = 0;
26
6
3
  my @prefixes;
27
6
100
71
  open($yaml, '<', $file) || return '';
28
5
5
  my @result;
29  my $line_result;
30
5
0
  my $mode;
31
5
0
  my $last;
32
5
46
  while (<$yaml>) {
33
521
206
    chomp;
34
521
50
276
    next if /^\s*#/;
35
521
100
50
33
426
    if (/^(\s*)(\S.*)/) {
36
519
298
      my ($prefix, $remainder) = ($1, $2);
37
519
100
595
      while ($level && length $prefix <= length $prefixes[$level - 1]) {
38
2
2
        delete $prefixes[$level--];
39      }
40
519
100
100
300
      if (@result && $level < scalar @path_split) {
41
2
2
        $last = 1;
42
2
1
        last;
43      }
44
517
50
235
      last if $last;
45
517
50
67
578
      if (!$level || length $prefix > length $prefixes[$level - 1]) {
46
517
100
244
        if ($level == scalar @path_split) {
47
5
4
          push @result, $remainder;
48        } else {
49
512
178
          my $next = $path_split[$level];
50
512
100
798
          if ($remainder =~ /$next:(.*)$/) {
51
12
9
            $prefixes[$level++] = $prefix;
52
12
100
15
            if ($level == scalar @path_split) {
53
5
1
              $mode = $1;
54
5
100
50
14
              if ($mode =~ /\s*([-+>|]+)\s*$/) {
55
2
3
                $mode = $1;
56              } elsif ($mode =~ /\s*(\S.*?)\s*$/) {
57
3
1
                my $value = $1;
58
3
3
                $value =~ s/^'(.*)'$/$1/;
59
3
1
                $line_result = $value;
60
3
2
                last;
61              }
62            }
63          }
64        }
65      }
66    } elsif (/^\s*$/ && @result) {
67
2
1
      push @result, '';
68    }
69  }
70
5
19
  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
1
  $mode = $1;
76
2
2
  my $suffix = '';
77
2
100
50
1
  if ($newlines eq '') {
78
1
1
    $suffix = "\n";
79  } elsif ($newlines =~ /-/) {
80
1
1
    $suffix = ' ';
81  }
82
2
0
  my $empty_lines = 0;
83
2
50
2
  unless ($newlines eq '+') {
84
2
2
    while ($result[$#result] eq '') {
85
1
0
      ++$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
1
  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
3
      my $line = shift @result;
100
3
50
1
      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
0
    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
5
  my ($key, $value, $message, $report_match, $file, $content) = @_;
115
5
5
  my ($state, $gh_yaml_mode) = (0, '');
116
5
2
  my @nests;
117
5
3
  my ($start_line, $start_pod, $end);
118
5
7
  my @lines = split /\n/, $content;
119
5
4
  my $line = 0;
120
5
1
  my @expected_key_path = split /\n/, $key;
121
5
3
  my @current_key_path;
122
5
3
  $key = quotemeta($key);
123
124
5
4
  for (@lines) {
125
65
23
    ++$line;
126
65
100
42
    if (/^(\s*)#/) {
127
5
50
3
      $end += length $_ if ($state == 3);
128
5
4
      next;
129    }
130
60
100
50
34
    if ($state == 0) {
131
56
100
58
      next unless /^(\s*)(-\s+|)(\S+)\s*:/;
132
37
31
      my ($spaces, $array_element, $record) = ($1, $2, $3);
133
37
18
      my $len = length "$spaces$array_element";
134
37
100
46
      while (scalar @nests && $len < $nests[$#nests]) {
135
8
10
        pop @nests;
136      }
137
37
100
100
49
      push @nests, $len if (! scalar @nests || $len > $nests[$#nests]);
138
37
100
15
      if ($#expected_key_path >= 1) {
139
10
8
        $#current_key_path = $#nests;
140
10
2
        $current_key_path[$#nests] = $record;
141
10
100
11
        next if $#nests != $#expected_key_path;
142
4
1
        my $unequal = 0;
143
4
3
        for my $i (0 .. $#nests) {
144
9
100
5
          if ($current_key_path[$i] ne $expected_key_path[$i]) {
145
3
2
            $unequal = 1;
146
3
1
            last;
147          }
148        }
149
4
100
3
        next if $unequal;
150
1
0
        $key = quotemeta($expected_key_path[$#nests]);
151      }
152
28
100
303
      if (/^\s*(($key)\s*:\s*([|>](?:[-+]\d*)?|\$\{\{.*|(?:"\s*|)$value))\s*$/) {
153
4
3
        $gh_yaml_mode = $3;
154
4
9
        ($start_line, $start_pos, $end, $match) = ($line, $-[2] + 1, $+[3] + 1, $1);
155
4
100
42
        report($file, $start_line, $start_pos, $end, $message, $match, $report_match) if ($gh_yaml_mode =~ /$value|\$\{\{/);
156
4
100
1505
        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
5
      if (/^\s*(?:#.*|)$/) {
166
0
0
        $end += length $_;
167
0
0
        next;
168      }
169
4
6
      /^(\s*)(\S.*?)\s*$/;
170
4
3
      my ($spaces, $v) = ($1, $2);
171
4
3
      $len = length $spaces;
172
4
100
50
24
      if (scalar @nests && $len > $nests[$#nests] && $v =~ /$value/) {
173
3
2
        $end += $len + length $v;
174
3
100
2
        if ($report_match) {
175
1
1
          $match .= $_;
176        } else {
177
2
2
          $match .= $v;
178        }
179
3
30
        report($file, $start_line, $start_pos, $end, $message, $match, $report_match);
180      }
181
4
4392
      pop @nests;
182
4
5
      $state = 0;
183    }
184  }
185}
186
1871;