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   231447 use strict;
  1         2  
  1         29  
4 1     1   7 use warnings;
  1         4  
  1         22  
5 1     1   6 use utf8;
  1         1  
  1         5  
6              
7 1     1   472 use App::ArduinoBuilder::Logger;
  1         3  
  1         72  
8 1     1   7 use Exporter 'import';
  1         13  
  1         1755  
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 937 my ($class, %options) = @_;
17 6         28 my $me = bless {config => {}, files => 0, options => {}}, $class;
18 6 50       21 $me->read_file($options{file}, %options) if $options{file};
19 6         10 for my $f (@{$options{files}}) {
  6         18  
20 1         6 $me->read_file($f, %options);
21             }
22 6 100       19 $me->resolve(%options) if $options{resolve};
23 6         18 return $me;
24             }
25              
26             sub read_file {
27 2     2 0 6532 my ($this, $file_name, %options) = @_;
28 2         5 %options = (%{$this->{options}}, %options);
  2         10  
29 2 50 33     8 return if $options{allow_missing} && ! -f $file_name;
30 2 50       91 open my $fh, '<', $file_name or fatal "Can’t open '${file_name}': $!";
31 2         71 while (my $l = <$fh>) {
32 12 100       54 next if $l =~ m/^\s*(?:#.*)?$/; # Only whitespace or comment
33 8 50       53 fatal "Unparsable line in ${file_name}: ${l}" unless $l =~ m/^\s*([-0-9a-z_.]+?)\s*=\s*(.*?)\s*$/i;
34 8 50 33     74 $this->{config}{$1} = $2 if !(exists $this->{config}{$1}) || $options{allow_override};
35             }
36 2         7 $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 71 my ($this, $key, %options) = @_;
52 26         44 %options = (%{$this->{options}}, %options);
  26         66  
53 26 0 33     60 return $options{default} if !$this->exists($key) && exists $options{default};
54 26 50       65 $options{allow_partial} = 1 if $options{no_resolve};
55 26         62 my $v = _resolve_key($key, $this->{config}, %options, allow_partial => 1);
56 26 50       57 fatal "Key '$key' does not exist in the configuration." unless defined $v;
57 26 50 66     111 fatal "Key '$key' has unresolved reference to value '$1'." if $v =~ m/\{([^}]+)\}/ && !$options{allow_partial};
58 26         63 return $v;
59             }
60              
61             sub keys {
62 6     6 0 12 my ($this, %options) = @_;
63 6         8 return keys %{$this->{config}};
  6         32  
64             }
65              
66             sub exists {
67 42     42 0 69 my ($this, $key) = @_;
68 42         128 return exists $this->{config}{$key};
69             }
70              
71             sub set {
72 7     7 0 30 my ($this, $key, $value, %options) = @_;
73 7         11 %options = (%{$this->{options}}, %options);
  7         15  
74 7 50       17 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         17 $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   125 my ($key, $config, %options) = @_;
90 56 50       117 return $options{with}{$key} if exists $options{with}{$key};
91 56 100 100     132 return $options{base}->get($key, %options{grep { $_ ne 'base'} CORE::keys %options}) if exists $options{base} && $options{base}->exists($key);
  18         56  
92 50 100       95 if (not exists $config->{$key}) {
93 14 50       29 fatal "Can’t resolve key '${key}' in the configuration." unless $options{allow_partial};
94 14         31 return;
95             }
96 36         55 my $value = $config->{$key};
97 36 50       65 return $value if $options{no_resolve};
98 36         118 while ($value =~ m/\{([^{}]+)\}/g) {
99 30         64 my $new_key = $1;
100 30         60 my $match_start = $-[0];
101 30         77 my $match_len = $+[0] - $-[0];
102 30         58 my $l = 2 + length($new_key);
103 30         72 my $new_value = _resolve_key($new_key, $config, %options);
104 30 100       137 substr $value, $match_start, $match_len, $new_value if defined $new_value;
105             }
106 36         86 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 20 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 13 my ($this, %options) = @_;
122 3         4 %options = (%{$this->{options}}, %options);
  3         11  
123 3 50       12 $options{allow_partial} = 1 if $options{no_resolve};
124 3         4 my $config = $this->{config};
125 3   66     11 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         12 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 6 my ($this, $prefix) = @_;
142 2         10 my $filtered = App::ArduinoBuilder::Config->new();
143 2         6 $filtered->{options}{base} = $this;
144 2         5 while (my ($k, $v) = each %{$this->{config}}) {
  10         36  
145 8 100       52 if ($k =~ m/^\Q$prefix\E\./) {
146 6         26 $filtered->{config}{substr($k, $+[0])} = $v;
147             }
148             }
149 2         7 return $filtered;
150             }
151              
152             sub dump {
153 6     6 0 15 my ($this, $prefix) = @_;
154 6         10 my $out = '';
155 6   100     22 my $p = $prefix // '';
156 6         16 for my $k (sort($this->keys())) {
157 18         44 my $v = $this->get($k, allow_partial => 1);
158 18         56 $out .= "${p}${k}=${v}\n";
159             }
160 6         36 return $out;
161             }
162              
163             1;