| File: | lib/CheckSpelling/LoadEnv.pm |
| Coverage: | 85.9% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | #! -*-perl-*- | |||||
| 2 | ||||||
| 3 | package CheckSpelling::LoadEnv; | |||||
| 4 | ||||||
| 5 | 2 2 2 | 108045 4 99 | use feature 'unicode_strings'; | |||
| 6 | 2 2 2 | 200 4449 80 | use Encode qw/decode_utf8 encode_utf8 FB_DEFAULT/; | |||
| 7 | 2 2 2 | 410 53264 36 | use YAML::PP; | |||
| 8 | 2 2 2 | 318 5638 1039 | use JSON::PP; | |||
| 9 | ||||||
| 10 | sub print_var_val { | |||||
| 11 | 34 | 4505 | my ($var, $val) = @_; | |||
| 12 | 34 | 32 | if ($var =~ /[-a-z]/) { | |||
| 13 | 1 | 14 | print STDERR "Found improperly folded key in inputs '$var'\n"; | |||
| 14 | 1 | 2 | return; | |||
| 15 | } | |||||
| 16 | 33 | 22 | return if $val eq ''; | |||
| 17 | 32 | 70 | print qq<export INPUT_$var='$val';\n>; | |||
| 18 | } | |||||
| 19 | ||||||
| 20 | sub escape_var_val { | |||||
| 21 | 67 | 913 | my ($var, $val) = @_; | |||
| 22 | 67 | 47 | $val =~ s/([\$])/\\$1/g; | |||
| 23 | 67 | 32 | $val =~ s/'/'"'"'/g; | |||
| 24 | 67 | 57 | $var = uc $var; | |||
| 25 | 67 | 31 | $var =~ s/-/_/g; | |||
| 26 | 67 | 79 | return ($var, $val); | |||
| 27 | } | |||||
| 28 | ||||||
| 29 | sub parse_config_file { | |||||
| 30 | 2 | 1649 | my ($config_data) = @_; | |||
| 31 | 2 | 3 | local $/ = undef; | |||
| 32 | 2 | 4 | my $base_config_data = <$config_data>; | |||
| 33 | 2 | 4 | close $config_data; | |||
| 34 | 2 | 9 | return decode_json($base_config_data || '{}'); | |||
| 35 | } | |||||
| 36 | ||||||
| 37 | sub parse_inputs { | |||||
| 38 | 2 | 544 | my $input = $ENV{INPUTS}; | |||
| 39 | 2 | 2 | my %inputs; | |||
| 40 | 2 | 3 | if ($input) { | |||
| 41 | 2 2 | 1 6 | %inputs = %{decode_json(Encode::encode_utf8($input))}; | |||
| 42 | } | |||||
| 43 | ||||||
| 44 | 2 | 1161 | my %input_map; | |||
| 45 | 2 | 3 | for my $key (keys %inputs) { | |||
| 46 | 7 | 7 | next unless $key; | |||
| 47 | 7 | 5 | my $val = $inputs{$key}; | |||
| 48 | 7 | 6 | next unless $val ne ''; | |||
| 49 | 7 | 5 | my $var = $key; | |||
| 50 | 7 | 5 | if ($val =~ /^github_pat_/) { | |||
| 51 | 0 | 0 | print STDERR "Censoring `$var` (unexpected-input-value)\n"; | |||
| 52 | 0 | 0 | next; | |||
| 53 | } | |||||
| 54 | 7 | 7 | next if $var =~ /\s/; | |||
| 55 | 7 | 8 | next if $var =~ /[-_](?:key|token)$/; | |||
| 56 | 7 | 12 | if ($var =~ /-/ && $inputs{$var} ne '') { | |||
| 57 | 1 | 0 | my $var_pattern = $var; | |||
| 58 | 1 | 2 | $var_pattern =~ s/-/[-_]/g; | |||
| 59 | 1 6 | 1 24 | my @vars = grep { /^${var_pattern}$/ && ($var ne $_) && $inputs{$_} ne '' && $inputs{$var} ne $inputs{$_} } keys %inputs; | |||
| 60 | 1 | 2 | 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 | 3 | $var =~ s/-/_/g; | |||
| 64 | } | |||||
| 65 | 7 | 6 | ($var, $val) = escape_var_val($var, $val); | |||
| 66 | 7 | 18 | $input_map{$var} = $val; | |||
| 67 | } | |||||
| 68 | ||||||
| 69 | 2 | 2 | my $parsed_inputs = { | |||
| 70 | maybe_load_inputs_from => $maybe_load_inputs_from, | |||||
| 71 | input_map => \%input_map, | |||||
| 72 | }; | |||||
| 73 | 2 | 5 | parse_action_config($parsed_inputs); | |||
| 74 | 2 | 7 | return $parsed_inputs; | |||
| 75 | } | |||||
| 76 | ||||||
| 77 | sub parse_action_config { | |||||
| 78 | 2 | 3 | my ($parsed_inputs) = @_; | |||
| 79 | 2 | 2 | my $action_yml_path = $ENV{action_yml}; | |||
| 80 | 2 | 3 | return unless defined $action_yml_path; | |||
| 81 | ||||||
| 82 | 2 | 3 | my $action = YAML::PP::LoadFile($action_yml_path); | |||
| 83 | 2 | 348301 | return unless defined $action->{inputs}; | |||
| 84 | 2 2 | 3 7 | my %input_map = %{$parsed_inputs->{'input_map'}}; | |||
| 85 | 2 2 | 2 192 | my %action_inputs = %{$action->{inputs}}; | |||
| 86 | 2 | 36 | for my $key (sort keys %action_inputs) { | |||
| 87 | 134 134 | 59 204 | my %ref = %{$action_inputs{$key}}; | |||
| 88 | 134 | 102 | next unless defined $ref{default}; | |||
| 89 | 118 | 86 | next if defined $input_map{$key}; | |||
| 90 | 118 | 49 | my $var = $key; | |||
| 91 | 118 | 113 | next if $var =~ /[-_](?:key|token)$/i; | |||
| 92 | 112 | 86 | if ($var =~ s/-/_/g) { | |||
| 93 | 24 | 16 | next if defined $input_map{$var}; | |||
| 94 | } | |||||
| 95 | 112 | 66 | my $val = $ref{default}; | |||
| 96 | 112 | 84 | next if $val eq ''; | |||
| 97 | 58 | 42 | ($var, $val) = escape_var_val($var, $val); | |||
| 98 | 58 | 53 | next if defined $input_map{$var}; | |||
| 99 | 54 | 72 | $input_map{$var} = $val; | |||
| 100 | } | |||||
| 101 | 2 | 110 | $parsed_inputs->{'input_map'} = \%input_map; | |||
| 102 | } | |||||
| 103 | ||||||
| 104 | sub get_json_config_path { | |||||
| 105 | 1 | 798 | 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 | ||||||
| 110 | 1; | |||||