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

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