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; |