File Coverage

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

linestmtbrancondsubtimecode
1#! -*-perl-*-
2
3package CheckSpelling::Yaml;
4
5our $VERSION='0.1.0';
6
1
1
1
1
104997
2
633
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
161
  my ($file, $path) = @_;
24
6
7
  my @path_split = split /\./, $path;
25
6
3
  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
49
  while (<$yaml>) {
33
514
204
    chomp;
34
514
100
283
    next if /^\s*#/;
35
513
100
50
33
402
    if (/^(\s*)(\S.*)/) {
36
511
309
      my ($prefix, $remainder) = ($1, $2);
37
511
100
600
      while ($level && length $prefix <= length $prefixes[$level - 1]) {
38
2
2
        delete $prefixes[$level--];
39      }
40
511
100
100
260
      if (@result && $level < scalar @path_split) {
41
2
2
        $last = 1;
42
2
1
        last;
43      }
44
509
50
242
      last if $last;
45
509
50
67
529
      if (!$level || length $prefix > length $prefixes[$level - 1]) {
46
509
100
248
        if ($level == scalar @path_split) {
47
5
5
          push @result, $remainder;
48        } else {
49
504
178
          my $next = $path_split[$level];
50
504
100
785
          if ($remainder =~ /$next:(.*)$/) {
51
12
7
            $prefixes[$level++] = $prefix;
52
12
100
14
            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
2
                my $value = $1;
58
3
3
                $value =~ s/^'(.*)'$/$1/;
59
3
0
                $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
19
  close $yaml;
71
5
100
10
  return $line_result unless @result;
72
2
1
  my $newlines = '';
73
2
100
3
  $newlines = $1 if $mode =~ /([-+])/;
74
2
2
  $mode =~ /([|>]?)/;
75
2
1
  $mode = $1;
76
2
1
  my $suffix = '';
77
2
100
50
2
  if ($newlines eq '') {
78
1
3
    $suffix = "\n";
79  } elsif ($newlines =~ /-/) {
80
1
1
    $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
1
  if ($mode eq '>') {
96
1
1
    my @output;
97    my $tentative;
98
1
1
    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
4
4
5
  my ($key, $value, $message, $report_match, $file, $content) = @_;
115
4
3
  my ($state, $gh_yaml_mode) = (0, '');
116
4
1
  my @nests;
117
4
2
  my ($start_line, $start_pod, $end);
118
4
6
  my @lines = split /\n/, $content;
119
4
3
  my $line = 0;
120
121
4
3
  for (@lines) {
122
52
16
    ++$line;
123
52
100
41
    if (/^(\s*)#/) {
124
4
50
2
      $end += length $_ if ($state == 3);
125
4
3
      next;
126    }
127
48
100
50
19
    if ($state == 0) {
128
45
100
48
      next unless /^(\s*)\S+\s*:/;
129
27
11
      my $spaces = $1;
130
27
19
      my $len = length $spaces;
131
27
100
32
      while (scalar @nests && $len < $nests[$#nests]) {
132
4
4
        pop @nests;
133      }
134
27
100
100
28
      push @nests, $len if (! scalar @nests || $len > $nests[$#nests]);
135
27
100
223
      if (/^\s*(($key)\s*:\s*([|>](?:[-+]\d*)?|\$\{\{.*|(?:"\s*|)$value))\s*$/) {
136
3
3
        $gh_yaml_mode = $3;
137
3
6
        ($start_line, $start_pos, $end, $match) = ($line, $-[2] + 1, $+[3] + 1, $1);
138
3
100
29
        report($file, $start_line, $start_pos, $end, $message, $match, $report_match) if ($gh_yaml_mode =~ /$value|\$\{\{/);
139
3
100
1499
        if ($report_match) {
140
2
2
          $_ =~ /^\s*(.*)/;
141
2
1
          $match = "$_\n";
142        } else {
143
1
1
          $match = "$key: ";
144        }
145
3
3
        $state = 1;
146      }
147    } elsif ($state == 1) {
148
3
50
4
      if (/^\s*(?:#.*|)$/) {
149
0
0
        $end += length $_;
150
0
0
        continue;
151      }
152
3
3
      /^(\s*)(\S.*?)\s*$/;
153
3
4
      my ($spaces, $v) = ($1, $2);
154
3
2
      $len = length $spaces;
155
3
100
50
13
      if (scalar @nests && $len > $nests[$#nests] && $v =~ /$value/) {
156
2
2
        $end += $len + length $v;
157
2
100
1
        if ($report_match) {
158
1
1
          $match .= $_;
159        } else {
160
1
1
          $match .= $v;
161        }
162
2
3
        report($file, $start_line, $start_pos, $end, $message, $match, $report_match);
163      }
164
3
2917
      pop @nests;
165
3
3
      $state = 0;
166    }
167  }
168}
169
1701;