File Coverage

File:lib/CheckSpelling/LoadEnv.pm
Coverage:85.9%

linestmtbrancondsubtimecode
1#! -*-perl-*-
2
3package CheckSpelling::LoadEnv;
4
5
2
2
2
111099
1
134
use feature 'unicode_strings';
6
2
2
2
196
4821
98
use Encode qw/decode_utf8 encode_utf8 FB_DEFAULT/;
7
2
2
2
414
55362
40
use YAML::PP;
8
2
2
2
340
6015
1046
use JSON::PP;
9
10sub print_var_val {
11
34
4002
    my ($var, $val) = @_;
12
34
36
    if ($var =~ /[-a-z]/) {
13
1
13
        print STDERR "Found improperly folded key in inputs '$var'\n";
14
1
2
        return;
15    }
16
33
24
    return if $val eq '';
17
32
103
    print qq<export INPUT_$var='$val';\n>;
18}
19
20sub escape_var_val {
21
67
807
    my ($var, $val) = @_;
22
67
42
    $val =~ s/([\$])/\\$1/g;
23
67
48
    $val =~ s/'/'"'"'/g;
24
67
52
    $var = uc $var;
25
67
40
    $var =~ s/-/_/g;
26
67
55
    return ($var, $val);
27}
28
29sub parse_config_file {
30
2
1730
    my ($config_data) = @_;
31
2
3
    local $/ = undef;
32
2
4
    my $base_config_data = <$config_data>;
33
2
2
    close $config_data;
34
2
8
    return decode_json($base_config_data || '{}');
35}
36
37sub parse_inputs {
38
2
560
    my $input = $ENV{INPUTS};
39
2
2
    my %inputs;
40
2
3
    if ($input) {
41
2
2
1
7
        %inputs = %{decode_json(Encode::encode_utf8($input))};
42    }
43
44
2
1163
    my %input_map;
45
2
3
    for my $key (keys %inputs) {
46
7
6
        next unless $key;
47
7
7
        my $val = $inputs{$key};
48
7
5
        next unless $val ne '';
49
7
4
        my $var = $key;
50
7
6
        if ($val =~ /^github_pat_/) {
51
0
0
            print STDERR "Censoring `$var` (unexpected-input-value)\n";
52
0
0
            next;
53        }
54
7
6
        next if $var =~ /\s/;
55
7
9
        next if $var =~ /[-_](?:key|token)$/;
56
7
10
        if ($var =~ /-/ && $inputs{$var} ne '') {
57
1
1
            my $var_pattern = $var;
58
1
2
            $var_pattern =~ s/-/[-_]/g;
59
1
6
2
26
            my @vars = grep { /^${var_pattern}$/ && ($var ne $_) && $inputs{$_} ne '' && $inputs{$var} ne $inputs{$_} } keys %inputs;
60
1
1
            if (@vars) {
61
0
0
0
0
                print STDERR 'Found conflicting inputs for '.$var." ($inputs{$var}): ".join(', ', map { "$_ ($inputs{$_})" } @vars)." (migrate-underscores-to-dashes)\n";
62            }
63
1
5
            $var =~ s/-/_/g;
64        }
65
7
6
        ($var, $val) = escape_var_val($var, $val);
66
7
15
        $input_map{$var} = $val;
67    }
68
69
2
5
    my $parsed_inputs = {
70        maybe_load_inputs_from => $maybe_load_inputs_from,
71        input_map => \%input_map,
72    };
73
2
3
    parse_action_config($parsed_inputs);
74
2
9
    return $parsed_inputs;
75}
76
77sub parse_action_config {
78
2
2
    my ($parsed_inputs) = @_;
79
2
1
    my $action_yml_path = $ENV{action_yml};
80
2
3
    return unless defined $action_yml_path;
81
82
2
4
    my $action = YAML::PP::LoadFile($action_yml_path);
83
2
342839
    return unless defined $action->{inputs};
84
2
2
5
10
    my %input_map = %{$parsed_inputs->{'input_map'}};
85
2
2
2
598
    my %action_inputs = %{$action->{inputs}};
86
2
41
    for my $key (sort keys %action_inputs) {
87
134
134
73
233
        my %ref = %{$action_inputs{$key}};
88
134
110
        next unless defined $ref{default};
89
118
90
        next if defined $input_map{$key};
90
118
61
        my $var = $key;
91
118
120
        next if $var =~ /[-_](?:key|token)$/i;
92
112
99
        if ($var =~ s/-/_/g) {
93
24
23
            next if defined $input_map{$var};
94        }
95
112
55
        my $val = $ref{default};
96
112
86
        next if $val eq '';
97
58
39
        ($var, $val) = escape_var_val($var, $val);
98
58
47
        next if defined $input_map{$var};
99
54
68
        $input_map{$var} = $val;
100    }
101
2
154
    $parsed_inputs->{'input_map'} = \%input_map;
102}
103
104sub get_json_config_path {
105
1
774
    my ($parsed_inputs) = @_;
106
1
5
    my $config = $parsed_inputs->{'input_map'}{'config'} || '.github/actions/spelling';
107
1
4
    return "$config/config.json";
108}
109
1101;