line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl -w |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# ProjectBuilder Conf module |
4
|
|
|
|
|
|
|
# Conf files subroutines brought by the the Project-Builder project |
5
|
|
|
|
|
|
|
# which can be easily used by wahtever perl project |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# Copyright B. Cornec 2007-2016 |
8
|
|
|
|
|
|
|
# Eric Anderson's changes are (c) Copyright 2012 Hewlett Packard |
9
|
|
|
|
|
|
|
# Provided under the GPL v2 |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# $Id$ |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
package ProjectBuilder::Conf; |
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
436
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
27
|
|
17
|
1
|
|
|
1
|
|
5
|
use Carp 'confess'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
58
|
|
18
|
1
|
|
|
1
|
|
4
|
use Data::Dumper; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
35
|
|
19
|
1
|
|
|
1
|
|
3
|
use ProjectBuilder::Base; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
178
|
|
20
|
1
|
|
|
1
|
|
4
|
use ProjectBuilder::Version; |
|
1
|
|
|
|
|
0
|
|
|
1
|
|
|
|
|
37
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# Inherit from the "Exporter" module which handles exporting functions. |
23
|
|
|
|
|
|
|
|
24
|
1
|
|
|
1
|
|
3
|
use vars qw($VERSION $REVISION @ISA @EXPORT); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
43
|
|
25
|
1
|
|
|
1
|
|
3
|
use Exporter; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
1160
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# Export, by default, all the functions into the namespace of |
28
|
|
|
|
|
|
|
# any code which uses this module. |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
31
|
|
|
|
|
|
|
our @EXPORT = qw(pb_conf_init pb_conf_add pb_conf_read pb_conf_read_if pb_conf_write pb_conf_get pb_conf_get_if pb_conf_print pb_conf_get_all pb_conf_get_hash pb_conf_cache); |
32
|
|
|
|
|
|
|
($VERSION,$REVISION) = pb_version_init(); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# Global hash of conf files |
35
|
|
|
|
|
|
|
# Key is the conf file name |
36
|
|
|
|
|
|
|
# Value is its rank |
37
|
|
|
|
|
|
|
my %pbconffiles; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Global hash of conf file content |
40
|
|
|
|
|
|
|
# Key is the config keyword |
41
|
|
|
|
|
|
|
# Value is a hash whose key depends on the nature of the config keyword as documented |
42
|
|
|
|
|
|
|
# and value is the confguration value |
43
|
|
|
|
|
|
|
# We consider that values can not change during the life of pb |
44
|
|
|
|
|
|
|
my $h = (); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=pod |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 NAME |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
ProjectBuilder::Conf, part of the project-builder.org - module dealing with configuration files |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head1 DESCRIPTION |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
This modules provides functions dealing with configuration files. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=head1 SYNOPSIS |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
use ProjectBuilder::Conf; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# |
61
|
|
|
|
|
|
|
# Read hash codes of values from a configuration file and return table of pointers |
62
|
|
|
|
|
|
|
# |
63
|
|
|
|
|
|
|
my ($k1, $k2) = pb_conf_read_if("$ENV{'HOME'}/.pbrc","key1","key2"); |
64
|
|
|
|
|
|
|
my ($k) = pb_conf_read("$ENV{'HOME'}/.pbrc","key"); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=head1 USAGE |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=over 4 |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=item B |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
This function setup the environment PBPROJ for project-builder function usage from other projects. |
73
|
|
|
|
|
|
|
The first parameter is the project name. |
74
|
|
|
|
|
|
|
It sets up environment variables (PBPROJ) |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=cut |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub pb_conf_init { |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
0
|
1
|
|
my $proj=shift; |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
pb_log(1,"Entering pb_conf_init\n"); |
83
|
|
|
|
|
|
|
# |
84
|
|
|
|
|
|
|
# Check project name |
85
|
|
|
|
|
|
|
# Could be with env var PBPROJ |
86
|
|
|
|
|
|
|
# or option -p |
87
|
|
|
|
|
|
|
# if not defined take the first in conf file |
88
|
|
|
|
|
|
|
# |
89
|
0
|
0
|
0
|
|
|
|
if ((defined $ENV{'PBPROJ'}) && |
90
|
|
|
|
|
|
|
(not defined $proj)) { |
91
|
0
|
|
|
|
|
|
pb_log(2,"PBPROJ env var setup ($ENV{'PBPROJ'}) so using it\n"); |
92
|
0
|
|
|
|
|
|
$proj = $ENV{'PBPROJ'}; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
0
|
0
|
|
|
|
|
if (defined $proj) { |
96
|
0
|
|
|
|
|
|
$ENV{'PBPROJ'} = $proj; |
97
|
|
|
|
|
|
|
} else { |
98
|
0
|
|
|
|
|
|
$ENV{'PBPROJ'} = "default"; |
99
|
|
|
|
|
|
|
} |
100
|
0
|
|
|
|
|
|
pb_log(1,"PBPROJ = $ENV{'PBPROJ'}\n"); |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=item B |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
This function caches the configuration file content passed as first parameter into the a hash passed in second parameter |
107
|
|
|
|
|
|
|
It returns the modified hash |
108
|
|
|
|
|
|
|
Can be used in correlation with the %h hash to store permanently values or not if temporarily. |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=cut |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub pb_conf_cache { |
113
|
|
|
|
|
|
|
|
114
|
0
|
|
|
0
|
1
|
|
my $cf = shift; |
115
|
0
|
|
|
|
|
|
my $lh = shift; |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
# Read the content of the config file and cache it in the %h hash then available for queries |
118
|
0
|
0
|
|
|
|
|
open(CONF,$cf) || confess "Unable to open $cf"; |
119
|
0
|
|
|
|
|
|
while() { |
120
|
0
|
0
|
|
|
|
|
next if (/^#/); |
121
|
0
|
0
|
|
|
|
|
if (/^\s*([A-z0-9-_.]+)\s+([[A-z0-9-_.\?\[\]\*\+\\]+)\s*=\s*(.*)$/) { |
122
|
0
|
|
|
|
|
|
pb_log(3,"DEBUG: 1:$1 2:$2 3:$3\n"); |
123
|
0
|
|
|
|
|
|
$lh->{$1}->{$2}=$3; |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
} |
126
|
0
|
|
|
|
|
|
close(CONF); |
127
|
0
|
|
|
|
|
|
return($lh); |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item B |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
This function adds the configuration file to the list last, and cache their content in the %h hash |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=cut |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub pb_conf_add { |
137
|
|
|
|
|
|
|
|
138
|
0
|
|
|
0
|
1
|
|
pb_log(2,"DEBUG: pb_conf_add with ".Dumper(@_)."\n"); |
139
|
0
|
|
|
|
|
|
my $lh; |
140
|
|
|
|
|
|
|
|
141
|
0
|
|
|
|
|
|
foreach my $cf (@_) { |
142
|
0
|
0
|
|
|
|
|
if (! -r $cf) { |
143
|
0
|
|
|
|
|
|
pb_log(0,"WARNING: pb_conf_add can not read $cf\n"); |
144
|
0
|
|
|
|
|
|
next; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
# Skip already used conf files |
147
|
0
|
0
|
|
|
|
|
return($lh) if (defined $pbconffiles{$cf}); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# Add the new one at the end |
150
|
0
|
|
|
|
|
|
my $num = keys %pbconffiles; |
151
|
0
|
|
|
|
|
|
pb_log(2,"DEBUG: pb_conf_cache of $cf at position $num\n"); |
152
|
0
|
|
|
|
|
|
$pbconffiles{$cf} = $num; |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# Read the content of the config file |
155
|
0
|
|
|
|
|
|
$lh = pb_conf_cache($cf,$lh); |
156
|
|
|
|
|
|
|
# and cache it in the %h hash for further queries but after the previous |
157
|
|
|
|
|
|
|
# as we load conf files in reverse order (most precise first) |
158
|
0
|
|
|
|
|
|
pb_conf_add_last_in_hash($lh) |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=item B |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
This function returns a table of pointers on hashes |
166
|
|
|
|
|
|
|
corresponding to the keys in a configuration file passed in parameter. |
167
|
|
|
|
|
|
|
If that file doesn't exist, it returns undef. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
The format of the configuration file is as follows: |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
key tag = value1,value2,... |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
Supposing the file is called "$ENV{'HOME'}/.pbrc", containing the following: |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
$ cat $HOME/.pbrc |
176
|
|
|
|
|
|
|
pbver pb = 3 |
177
|
|
|
|
|
|
|
pbver default = 1 |
178
|
|
|
|
|
|
|
pblist pb = 12,25 |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
calling it like this: |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
my ($k1, $k2) = pb_conf_read_if("$ENV{'HOME'}/.pbrc","pbver","pblist"); |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
will allow to get the mapping: |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
$k1->{'pb'} contains 3 |
187
|
|
|
|
|
|
|
$k1->{'default'} contains 1 |
188
|
|
|
|
|
|
|
$k2->{'pb'} contains 12,25 |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Valid chars for keys and tags are letters, numbers, '-' and '_'. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
The file read is forgotten after its usage. If you want permanent caching of the data, use pb_conf_add then pb_conf_get |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=cut |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub pb_conf_read_if { |
197
|
|
|
|
|
|
|
|
198
|
0
|
|
|
0
|
1
|
|
my $conffile = shift; |
199
|
0
|
|
|
|
|
|
my @param = @_; |
200
|
|
|
|
|
|
|
|
201
|
0
|
0
|
|
|
|
|
open(CONF,$conffile) || return((undef)); |
202
|
0
|
|
|
|
|
|
close(CONF); |
203
|
0
|
|
|
|
|
|
return(pb_conf_read($conffile,@param)); |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=item B |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
This function is similar to B except that it dies when the file in parameter doesn't exist. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=cut |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub pb_conf_read { |
213
|
|
|
|
|
|
|
|
214
|
0
|
|
|
0
|
1
|
|
my $conffile = shift; |
215
|
0
|
|
|
|
|
|
my @param = @_; |
216
|
0
|
|
|
|
|
|
my @ptr; |
217
|
|
|
|
|
|
|
my $lh; |
218
|
|
|
|
|
|
|
|
219
|
0
|
|
|
|
|
|
$lh = pb_conf_cache($conffile,$lh); |
220
|
|
|
|
|
|
|
|
221
|
0
|
|
|
|
|
|
foreach my $param (@param) { |
222
|
0
|
|
|
|
|
|
push @ptr,$lh->{$param}; |
223
|
|
|
|
|
|
|
} |
224
|
0
|
|
|
|
|
|
return(@ptr); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=item B |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
This function writes in the file passed ias first parameter the hash of values passed as second parameter |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=cut |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
sub pb_conf_write { |
234
|
|
|
|
|
|
|
|
235
|
0
|
|
|
0
|
1
|
|
my $conffile = shift; |
236
|
0
|
|
|
|
|
|
my $h = shift; |
237
|
|
|
|
|
|
|
|
238
|
0
|
0
|
|
|
|
|
confess "No configuration file defined to write into !" if (not defined $conffile); |
239
|
0
|
0
|
|
|
|
|
confess "No hash defined to read from !" if (not defined $h); |
240
|
0
|
0
|
|
|
|
|
open(CONF,"> $conffile") || confess "Unable to write into $conffile"; |
241
|
|
|
|
|
|
|
|
242
|
0
|
|
|
|
|
|
foreach my $p (sort keys %$h) { |
243
|
0
|
|
|
|
|
|
my $j = $h->{$p}; |
244
|
0
|
|
|
|
|
|
foreach my $k (sort keys %$j) { |
245
|
0
|
|
|
|
|
|
print CONF "$p $k = $j->{$k}\n"; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
} |
248
|
0
|
|
|
|
|
|
close(CONF); |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=item B |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
This function returns a table, corresponding to a set of values queried in the hash passed in parameter or undef if it doesn't exist. |
256
|
|
|
|
|
|
|
It takes a table of keys as an input parameter. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=cut |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub pb_conf_get_in_hash_if { |
261
|
|
|
|
|
|
|
|
262
|
0
|
|
0
|
0
|
1
|
|
my $lh = shift || return(()); |
263
|
0
|
|
|
|
|
|
my @params = @_; |
264
|
0
|
|
|
|
|
|
my @ptr = (); |
265
|
|
|
|
|
|
|
|
266
|
0
|
|
|
|
|
|
pb_log(2,"DEBUG: pb_conf_get_in_hash_if on params ".join(' ',@params)."\n"); |
267
|
0
|
|
|
|
|
|
foreach my $k (@params) { |
268
|
0
|
|
|
|
|
|
push @ptr,$lh->{$k}; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
0
|
|
|
|
|
|
pb_log(2,"DEBUG: pb_conf_get_in_hash_if returns\n".Dumper(@ptr)); |
272
|
0
|
|
|
|
|
|
return(@ptr); |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=item B |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
This function returns a table, corresponding to a set of values queried in the %h hash or undef if it doen't exist. It takes a table of keys as an input parameter. |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
The format of the configurations file is as follows: |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
key tag = value1,value2,... |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
It will gather the values from all the configurations files passed to pb_conf_add, and return the values for the keys |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
$ cat $HOME/.pbrc |
288
|
|
|
|
|
|
|
pbver pb = 1 |
289
|
|
|
|
|
|
|
pblist pb = 4 |
290
|
|
|
|
|
|
|
$ cat $HOME/.pbrc2 |
291
|
|
|
|
|
|
|
pbver pb = 3 |
292
|
|
|
|
|
|
|
pblist default = 5 |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
calling it like this: |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
pb_conf_add("$HOME/.pbrc","$HOME/.pbrc2"); |
297
|
|
|
|
|
|
|
my ($k1, $k2) = pb_conf_get_if("pbver","pblist"); |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
will allow to get the mapping: |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
$k1->{'pb'} contains 3 |
302
|
|
|
|
|
|
|
$k2->{'pb'} contains 4 |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
Valid chars for keys and tags are letters, numbers, '-' and '_'. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=cut |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub pb_conf_get_if { |
309
|
|
|
|
|
|
|
|
310
|
0
|
|
|
0
|
1
|
|
return(pb_conf_get_in_hash_if($h,@_)); |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=item B |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
This function merges the values passed in the hash parameter into the %h hash, but only if itdoesn't already contain a value, or if the value is more precise (real value instead of default) |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
It is used internally by pb_conf_add and is not exported. |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=cut |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub pb_conf_add_last_in_hash { |
322
|
|
|
|
|
|
|
|
323
|
0
|
|
|
0
|
1
|
|
my $ptr = shift; |
324
|
|
|
|
|
|
|
|
325
|
0
|
0
|
|
|
|
|
return if (not defined $ptr); |
326
|
|
|
|
|
|
|
# TODO: test $ptr is a hash pointer |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# When called without correct initialization, try to work anyway with default as project |
329
|
0
|
0
|
|
|
|
|
pb_conf_init("default") if (not defined $ENV{'PBPROJ'}); |
330
|
|
|
|
|
|
|
|
331
|
0
|
|
|
|
|
|
my @params = (sort keys %$ptr); |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
# Everything is returned via @h |
334
|
|
|
|
|
|
|
# @h contains the values overloading what @ptr may contain. |
335
|
0
|
|
|
|
|
|
my @h = pb_conf_get_if(@params); |
336
|
0
|
|
|
|
|
|
my @ptr = pb_conf_get_in_hash_if($ptr,@params); |
337
|
|
|
|
|
|
|
|
338
|
0
|
|
|
|
|
|
my $p1; |
339
|
|
|
|
|
|
|
my $p2; |
340
|
|
|
|
|
|
|
|
341
|
0
|
|
|
|
|
|
pb_log(2,"DEBUG: pb_conf_add_last_in_hash params: ".Dumper(@params)."\n"); |
342
|
0
|
|
|
|
|
|
pb_log(2,"DEBUG: pb_conf_add_last_in_hash hash: ".Dumper(@h)."\n"); |
343
|
0
|
|
|
|
|
|
pb_log(2,"DEBUG: pb_conf_add_last_in_hash input: ".Dumper(@ptr)."\n"); |
344
|
|
|
|
|
|
|
|
345
|
0
|
|
|
|
|
|
foreach my $i (0..$#params) { |
346
|
0
|
|
|
|
|
|
$p1 = $h[$i]; |
347
|
0
|
|
|
|
|
|
$p2 = $ptr[$i]; |
348
|
|
|
|
|
|
|
# Always try to take the param from h |
349
|
|
|
|
|
|
|
# in order to mask what could be defined already in ptr |
350
|
0
|
0
|
|
|
|
|
if (not defined $p2) { |
351
|
|
|
|
|
|
|
# exit if no p1 either |
352
|
0
|
0
|
|
|
|
|
next if (not defined $p1); |
353
|
|
|
|
|
|
|
# No ref in p2 so use p1 |
354
|
0
|
0
|
0
|
|
|
|
$p1->{$ENV{'PBPROJ'}} = $p1->{'default'} if ((not defined $p1->{$ENV{'PBPROJ'}}) && (defined $p1->{'default'})); |
355
|
|
|
|
|
|
|
} else { |
356
|
|
|
|
|
|
|
# Ref found in p2 |
357
|
0
|
0
|
|
|
|
|
if (not defined $p1) { |
358
|
|
|
|
|
|
|
# No ref in p1 so use p2's value |
359
|
0
|
0
|
0
|
|
|
|
$p2->{$ENV{'PBPROJ'}} = $p2->{'default'} if ((not defined $p2->{$ENV{'PBPROJ'}}) && (defined $p2->{'default'})); |
360
|
0
|
|
|
|
|
|
$p1 = $p2; |
361
|
|
|
|
|
|
|
} else { |
362
|
|
|
|
|
|
|
# Both are defined - handling the overloading |
363
|
0
|
0
|
|
|
|
|
if (not defined $p1->{'default'}) { |
364
|
0
|
0
|
|
|
|
|
if (defined $p2->{'default'}) { |
365
|
0
|
|
|
|
|
|
$p1->{'default'} = $p2->{'default'}; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
0
|
0
|
|
|
|
|
if (not defined $p1->{$ENV{'PBPROJ'}}) { |
370
|
0
|
0
|
|
|
|
|
if (defined $p2->{$ENV{'PBPROJ'}}) { |
371
|
0
|
|
|
|
|
|
$p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}}; |
372
|
|
|
|
|
|
|
} else { |
373
|
0
|
0
|
|
|
|
|
$p1->{$ENV{'PBPROJ'}} = $p1->{'default'} if (defined $p1->{'default'}); |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
# Now copy back into p1 all p2 content which doesn't exist in p1 |
377
|
|
|
|
|
|
|
# p1 content always has priority over p2 |
378
|
0
|
|
|
|
|
|
foreach my $k (keys %$p2) { |
379
|
0
|
0
|
|
|
|
|
$p1->{$k} = $p2->{$k} if (not defined $p1->{$k}); |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
} |
383
|
0
|
|
|
|
|
|
$h->{$params[$i]} = $p1; |
384
|
|
|
|
|
|
|
} |
385
|
0
|
|
|
|
|
|
pb_log(2,"DEBUG: pb_conf_add_last_in_hash output: ".Dumper($h)."\n"); |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=item B |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
This function is the same B, except that it tests each returned value as they need to exist in that case. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=cut |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
sub pb_conf_get { |
395
|
|
|
|
|
|
|
|
396
|
0
|
|
|
0
|
1
|
|
my @param = @_; |
397
|
0
|
|
|
|
|
|
my @return = pb_conf_get_if(@param); |
398
|
0
|
|
|
|
|
|
my $proj = undef; |
399
|
|
|
|
|
|
|
|
400
|
0
|
0
|
|
|
|
|
if (not defined $ENV{'PBPROJ'}) { |
401
|
0
|
|
|
|
|
|
$proj = "unknown"; |
402
|
|
|
|
|
|
|
} else { |
403
|
0
|
|
|
|
|
|
$proj = $ENV{'PBPROJ'}; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
0
|
0
|
|
|
|
|
confess "No params found for $proj" if (not @return); |
407
|
|
|
|
|
|
|
|
408
|
0
|
|
|
|
|
|
foreach my $i (0..$#param) { |
409
|
0
|
0
|
|
|
|
|
confess "No $param[$i] defined for $proj" if (not defined $return[$i]); |
410
|
|
|
|
|
|
|
} |
411
|
0
|
|
|
|
|
|
return(@return); |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=item B |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
This function returns an array with all configuration parameters |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=cut |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
sub pb_conf_get_all { |
422
|
|
|
|
|
|
|
|
423
|
0
|
|
|
0
|
1
|
|
return(sort keys %$h); |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=item B |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
This function returns a pointer to the hash with all configuration parameters |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=cut |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
sub pb_conf_get_hash { |
434
|
|
|
|
|
|
|
|
435
|
0
|
|
|
0
|
1
|
|
return($h); |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=back |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=head1 WEB SITES |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
The main Web site of the project is available at L. Bug reports should be filled using the trac instance of the project at L. |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=head1 USER MAILING LIST |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
None exists for the moment. |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
=head1 AUTHORS |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
The Project-Builder.org team L lead by Bruno Cornec L. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=head1 COPYRIGHT |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
Project-Builder.org is distributed under the GPL v2.0 license |
455
|
|
|
|
|
|
|
described in the file C included with the distribution. |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=cut |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
1; |