File Coverage

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

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