File Coverage

blib/lib/App/ArduinoBuilder/Config.pm
Criterion Covered Total %
statement 98 112 87.5
branch 29 54 53.7
condition 14 26 53.8
subroutine 16 20 80.0
pod 0 14 0.0
total 157 226 69.4


line stmt bran cond sub pod time code
1             package App::ArduinoBuilder::Config;
2              
3 1     1   225887 use strict;
  1         2  
  1         30  
4 1     1   5 use warnings;
  1         2  
  1         21  
5 1     1   6 use utf8;
  1         2  
  1         11  
6              
7 1     1   435 use App::ArduinoBuilder::Logger;
  1         2  
  1         76  
8 1     1   7 use Exporter 'import';
  1         2  
  1         1765  
9              
10             our @EXPORT_OK = qw(get_os_name);
11              
12             # Reference for the whole configuration interpretation:
13             # https://arduino.github.io/arduino-cli/0.32/platform-specification
14              
15             sub new {
16 6     6 0 899 my ($class, %options) = @_;
17 6         28 my $me = bless {config => {}, files => 0, options => {}}, $class;
18 6 50       20 $me->read_file($options{file}, %options) if $options{file};
19 6         9 for my $f (@{$options{files}}) {
  6         18  
20 1         5 $me->read_file($f, %options);
21             }
22 6 100       20 $me->resolve(%options) if $options{resolve};
23 6         17 return $me;
24             }
25              
26             sub read_file {
27 2     2 0 7808 my ($this, $file_name, %options) = @_;
28 2         5 %options = (%{$this->{options}}, %options);
  2         11  
29 2 50 33     8 return if $options{allow_missing} && ! -f $file_name;
30 2 50       106 open my $fh, '<', $file_name or fatal "Can’t open '${file_name}': $!";
31 2         71 while (my $l = <$fh>) {
32 12 100       55 next if $l =~ m/^\s*(?:#.*)?$/; # Only whitespace or comment
33 8 50       54 fatal "Unparsable line in ${file_name}: ${l}" unless $l =~ m/^\s*([-0-9a-z_.]+?)\s*=\s*(.*?)\s*$/i;
34 8 50 33     83 $this->{config}{$1} = $2 if !(exists $this->{config}{$1}) || $options{allow_override};
35             }
36 2         9 $this->{file}++;
37 2         36 return 1;
38             }
39              
40             sub size {
41 0     0 0 0 my ($this) = @_;
42 0         0 return scalar keys %{$this->{config}};
  0         0  
43             }
44              
45             sub empty {
46 0     0 0 0 my ($this) = @_;
47 0         0 return $this->size() == 0;
48             }
49              
50             sub get {
51 26     26 0 59 my ($this, $key, %options) = @_;
52 26         40 %options = (%{$this->{options}}, %options);
  26         67  
53 26 0 33     55 return $options{default} if !$this->exists($key) && exists $options{default};
54 26 50       65 $options{allow_partial} = 1 if $options{no_resolve};
55 26         61 my $v = _resolve_key($key, $this->{config}, %options, allow_partial => 1);
56 26 50       53 fatal "Key '$key' does not exist in the configuration." unless defined $v;
57 26 50 66     88 fatal "Key '$key' has unresolved reference to value '$1'." if $v =~ m/\{([^}]+)\}/ && !$options{allow_partial};
58 26         61 return $v;
59             }
60              
61             sub keys {
62 6     6 0 12 my ($this, %options) = @_;
63 6         8 return keys %{$this->{config}};
  6         34  
64             }
65              
66             sub exists {
67 42     42 0 75 my ($this, $key) = @_;
68 42         122 return exists $this->{config}{$key};
69             }
70              
71             sub set {
72 7     7 0 38 my ($this, $key, $value, %options) = @_;
73 7         9 %options = (%{$this->{options}}, %options);
  7         16  
74 7 50       16 if (exists $this->{config}{$key}) {
75 0 0       0 return if $options{ignore_existing};
76 0 0       0 fatal "Key '$key' already exists." unless $options{allow_override};
77             }
78 7         15 $this->{config}{$key} = $value;
79 7         14 return;
80             }
81              
82             sub append {
83 0     0 0 0 my ($this, $key, $value) = @_;
84 0 0       0 $this->{config}{$key} .= ($this->{config}{$key} ? ' ' : '').$value;
85 0         0 return;
86             }
87              
88             sub _resolve_key {
89 56     56   127 my ($key, $config, %options) = @_;
90 56 50       114 return $options{with}{$key} if exists $options{with}{$key};
91 56 100 100     124 return $options{base}->get($key, %options{grep { $_ ne 'base'} CORE::keys %options}) if exists $options{base} && $options{base}->exists($key);
  18         46  
92 50 100       119 if (not exists $config->{$key}) {
93 14 50       25 fatal "Can’t resolve key '${key}' in the configuration." unless $options{allow_partial};
94 14         31 return;
95             }
96 36         56 my $value = $config->{$key};
97 36 50       71 return $value if $options{no_resolve};
98 36         120 while ($value =~ m/\{([^{}]+)\}/g) {
99 30         67 my $new_key = $1;
100 30         59 my $match_start = $-[0];
101 30         75 my $match_len = $+[0] - $-[0];
102 30         55 my $l = 2 + length($new_key);
103 30         74 my $new_value = _resolve_key($new_key, $config, %options);
104 30 100       144 substr $value, $match_start, $match_len, $new_value if defined $new_value;
105             }
106 36         84 return $value;
107             }
108              
109             # The Arduino OS name, based on the Perl OS name.
110             sub get_os_name {
111             # It is debattable how we want to treat cygwin and msys. For now we assume
112             # that they will be used with a windows native Arduino toolchain.
113 2 50 33 2 0 19 return 'windows' if $^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'msys';
      33        
114 2 50       6 return 'macosx' if $^O eq 'MacOS';
115 2         6 return 'linux';
116             }
117              
118             # This only does the OS resolution, not each key/value interpretation as this
119             # should always be done as late as possible in case some values changes later.
120             sub resolve {
121 3     3 0 11 my ($this, %options) = @_;
122 3         7 %options = (%{$this->{options}}, %options);
  3         10  
123 3 50       9 $options{allow_partial} = 1 if $options{no_resolve};
124 3         5 my $config = $this->{config};
125 3   66     18 my $os_name = $options{force_os_name} // get_os_name();
126 3         11 for my $k (CORE::keys %$config) {
127 13 100       65 $config->{$1} = $config->{$k} if $k =~ m/^(.*)\.$os_name$/;
128             }
129 3         10 return 1;
130             }
131              
132             # Definition from this are kept and not replaced by those from others.
133             sub merge {
134 0     0 0 0 my ($this, $other) = @_;
135 0         0 while (my ($k, $v) = each %{$other->{config}}) {
  0         0  
136 0 0       0 $this->{config}{$k} = $v unless exists $this->{config}{$k};
137             }
138             }
139              
140             sub filter {
141 2     2 0 7 my ($this, $prefix) = @_;
142 2         8 my $filtered = App::ArduinoBuilder::Config->new();
143 2         9 $filtered->{options}{base} = $this;
144 2         4 while (my ($k, $v) = each %{$this->{config}}) {
  10         42  
145 8 100       48 if ($k =~ m/^\Q$prefix\E\./) {
146 6         27 $filtered->{config}{substr($k, $+[0])} = $v;
147             }
148             }
149 2         7 return $filtered;
150             }
151              
152             sub dump {
153 6     6 0 16 my ($this, $prefix) = @_;
154 6         11 my $out = '';
155 6   100     23 my $p = $prefix // '';
156 6         14 for my $k (sort($this->keys())) {
157 18         56 my $v = $this->get($k, allow_partial => 1);
158 18         57 $out .= "${p}${k}=${v}\n";
159             }
160 6         28 return $out;
161             }
162              
163             1;