File Coverage

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

linestmtbrancondsubtimecode
1#! -*-perl-*-
2
3package CheckSpelling::Yaml;
4
5our $VERSION='0.1.0';
6
1
1
1
1
105329
2
640
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
4
4
160
  my ($file, $path) = @_;
24
4
4
  my @path_split = split /\./, $path;
25
4
1
  my $level = 0;
26
4
2
  my @prefixes;
27
4
100
49
  open($yaml, '<', $file) || return '';
28
3
4
  my @result;
29  my $line_result;
30
3
0
  my $mode;
31
3
0
  my $last;
32
3
30
  while (<$yaml>) {
33
358
136
    chomp;
34
358
100
194
    next if /^\s*#/;
35
357
50
0
0
264
    if (/^(\s*)(\S.*)/) {
36
357
225
      my ($prefix, $remainder) = ($1, $2);
37
357
67
415
      while ($level && length $prefix < length $prefixes[$level - 1]) {
38
0
0
        delete $prefixes[$level--];
39      }
40
357
50
33
218
      if (@result && $level < scalar @path_split) {
41
0
0
        $last = 1;
42
0
0
        last;
43      }
44
357
50
153
      last if $last;
45
357
50
67
368
      if (!$level || length $prefix > length $prefixes[$level - 1]) {
46
357
50
161
        if ($level == scalar @path_split) {
47
0
0
          push @result, $remainder;
48        } else {
49
357
127
          my $next = $path_split[$level];
50
357
100
558
          if ($remainder =~ /$next:(.*)$/) {
51
7
5
            $prefixes[$level++] = $prefix;
52
7
100
10
            if ($level == scalar @path_split) {
53
3
2
              $mode = $1;
54
3
50
50
10
              if ($mode =~ /\s*([-+>|]+)\s*$/) {
55
0
0
                $mode = $1;
56              } elsif ($mode =~ /\s*(\S.*?)\s*$/) {
57
3
1
                my $value = $1;
58
3
2
                $value =~ s/^'(.*)'$/$1/;
59
3
2
                $line_result = $value;
60
3
3
                last;
61              }
62            }
63          }
64        }
65      }
66    } elsif (/^\s*$/ && @result) {
67
0
0
      push @result, '';
68    }
69  }
70
3
11
  close $yaml;
71
3
50
8
  return $line_result unless @result;
72
0
0
  $mode =~ /([-+])/;
73
0
0
  my $newlines = $1;
74
0
0
  $mode =~ /([|>]?)/;
75
0
0
  $mode = $1;
76
0
0
  my $suffix;
77
0
0
0
  if ($newlines eq '') {
78
0
0
    $suffix = "\n";
79  }
80
0
0
0
  unless ($newlines eq '+') {
81
0
0
    pop @result while ($result[$#result] eq '');
82  }
83
0
0
0
  if ($mode eq '') {
84
0
0
    return (join ' ', @result).$suffix;
85  }
86
0
0
0
  if ($mode eq '|') {
87
0
0
    return (join "\n", @result).$suffix;
88  }
89
0
0
0
  if ($mode eq '>') {
90
0
0
    my @output;
91    my $tentative;
92
0
0
    while (@result) {
93
0
0
      my $line = shift @result;
94
0
0
0
      if ($line eq '') {
95
0
0
        push @output, $tentative;
96
0
0
        $tentative = '';
97      } else {
98
0
0
        $tentative .= $line;
99      }
100    }
101
0
0
    push @output, $tentative;
102
0
0
    return (join "\n", @output).$suffix;
103  }
104
0
0
  return (join ' ? ', @result).$suffix;
105}
106
107sub check_yaml_key_value {
108
4
4
4
  my ($key, $value, $message, $report_match, $file, $content) = @_;
109
4
3
  my ($state, $gh_yaml_mode) = (0, '');
110
4
1
  my @nests;
111
4
3
  my ($start_line, $start_pod, $end);
112
4
6
  my @lines = split /\n/, $content;
113
4
2
  my $line = 0;
114
115
4
2
  for (@lines) {
116
52
22
    ++$line;
117
52
100
31
    if (/^(\s*)#/) {
118
4
50
3
      $end += length $_ if ($state == 3);
119
4
2
      next;
120    }
121
48
100
50
28
    if ($state == 0) {
122
45
100
46
      next unless /^(\s*)\S+\s*:/;
123
27
15
      my $spaces = $1;
124
27
9
      my $len = length $spaces;
125
27
100
38
      while (scalar @nests && $len < $nests[$#nests]) {
126
4
5
        pop @nests;
127      }
128
27
100
100
30
      push @nests, $len if (! scalar @nests || $len > $nests[$#nests]);
129
27
100
230
      if (/^\s*(($key)\s*:\s*([|>](?:[-+]\d*)?|\$\{\{.*|(?:"\s*|)$value))\s*$/) {
130
3
5
        $gh_yaml_mode = $3;
131
3
6
        ($start_line, $start_pos, $end, $match) = ($line, $-[2] + 1, $+[3] + 1, $1);
132
3
100
28
        report($file, $start_line, $start_pos, $end, $message, $match, $report_match) if ($gh_yaml_mode =~ /$value|\$\{\{/);
133
3
100
1515
        if ($report_match) {
134
2
3
          $_ =~ /^\s*(.*)/;
135
2
5
          $match = "$_\n";
136        } else {
137
1
1
          $match = "$key: ";
138        }
139
3
1
        $state = 1;
140      }
141    } elsif ($state == 1) {
142
3
50
7
      if (/^\s*(?:#.*|)$/) {
143
0
0
        $end += length $_;
144
0
0
        continue;
145      }
146
3
3
      /^(\s*)(\S.*?)\s*$/;
147
3
4
      my ($spaces, $v) = ($1, $2);
148
3
2
      $len = length $spaces;
149
3
100
50
14
      if (scalar @nests && $len > $nests[$#nests] && $v =~ /$value/) {
150
2
2
        $end += $len + length $v;
151
2
100
2
        if ($report_match) {
152
1
0
          $match .= $_;
153        } else {
154
1
1
          $match .= $v;
155        }
156
2
2
        report($file, $start_line, $start_pos, $end, $message, $match, $report_match);
157      }
158
3
2902
      pop @nests;
159
3
3
      $state = 0;
160    }
161  }
162}
163
1641;