source: devel/pb-modules/lib/ProjectBuilder/Conf.pm @ 1495

Last change on this file since 1495 was 1495, checked in by bruno, 7 years ago

r4735@localhost: bruno | 2012-05-07 03:46:39 +0200

  • Conf.pm largely rewritten to cache all conf files into a local $h hash in which conf files are added in reverse order.

The new pb_conf_hash stores a configuration file into a hash structure passed in parameter.
pb_conf_add now triggers the computation of the hash structure with pb_conf_cache and adds it to the main $h hash.
pb_conf_read_if now just uses the content in the $h hash to return its table.
pb_conf_get_in_hash_if function added to do the same as pb_conf_read_if on the cached $h hash instead of a configuration file.
pb_conf_get_if now uses pb_conf_get_in_hash_if and the $h hash without re-reading conf files
pb_conf_add_last_in_hash adds the content of a hash behind the content of the $h main hash (was done in pb_conf_get before)
pb_env_init now calls pb_conf_init to have PBPROJ defined when needed.
pb seems to work with this new version (builds itself)

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