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

Last change on this file since 2250 was 2250, checked in by bruno, 2 years ago

Doc fixes mostly

File size: 12.8 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-2016
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#use YAML;
22
23# Inherit from the "Exporter" module which handles exporting functions.
24 
25use vars qw($VERSION $REVISION @ISA @EXPORT);
26use Exporter;
27 
28# Export, by default, all the functions into the namespace of
29# any code which uses this module.
30 
31our @ISA = qw(Exporter);
32our @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_get_all pb_conf_get_hash pb_conf_cache);
33($VERSION,$REVISION) = pb_version_init();
34
35# Global hash of conf files
36# Key is the conf file name
37# Value is its rank
38my %pbconffiles;
39
40# Global hash of conf file content
41# Key is the config keyword
42# Value is a hash whose key depends on the nature of the config keyword as documented
43# and value is the confguration value
44# We consider that values can not change during the life of pb
45my $h = ();
46
47=pod
48
49=head1 NAME
50
51ProjectBuilder::Conf, part of the project-builder.org - module dealing with configuration files
52
53=head1 DESCRIPTION
54
55This modules provides functions dealing with configuration files.
56
57=head1 SYNOPSIS
58
59  use ProjectBuilder::Conf;
60
61  #
62  # Read hash codes of values from a configuration file and return table of pointers
63  #
64  my ($k1, $k2) = pb_conf_read_if("$ENV{'HOME'}/.pbrc","key1","key2");
65  my ($k) = pb_conf_read("$ENV{'HOME'}/.pbrc","key");
66
67=head1 USAGE
68
69The configuration files are loaded in a specific order from most generic to the most specific
70to allow for overwrite to work:
71
72For recent versions of pb (>= 0.15):
731. /usr/share/pb/pb.yml     - the read-only system conf file provided by install
742. /etc/pb/pb.yml           - the same global conf file given to the sysadmin in order to make system wide modifications
753. /path/to/project.yml     - Configuration file for the project we're building for
764. /vm|vepath/to/.pbrc.yml  - configuration file for VM, VE or RM specific parameters. Cumulative should be orthogonal
775. $HOME/.pbrc.yml          - user's configuration file
78
79For versions of pb up to 0.14:
801. /usr/share/pb/pb.conf    - the read-only system conf file provided by install
812. /etc/pb/pb.conf          - the same global conf file given to the sysadmin in order to make system wide modifications
823. /path/to/project.pb      - Configuration file for the project we're building for
834. /(vm|ve|rm)path/to/.pbrc - configuration file for VM, VE or RM specific parameters. Cumulative should be orthogonal
845. $HOME/.pbrc              - user's configuration file
85
86The format of the configuration file is as follows:
87
88For recent versions of pb (>= 0.15):
89YAML format is now used - The version of the configuration files is
90
91Supposing the file is called "$ENV{'HOME'}/.pbrc.yml", containing the following:
92
93  $ cat $HOME/.pbrc.yml
94  ---
95    pbver:
96      - pb: 3
97      - default: 1
98    pblist:
99      - pb: 12,25
100
101calling it like this:
102
103  my ($k1, $k2) = pb_conf_read_if("$ENV{'HOME'}/.pbrc.yml","pbver","pblist");
104
105will allow to get the mapping:
106
107  $k1->{'pb'} contains 3
108  $k1->{'default'} contains 1
109  $k2->{'pb'} contains 12,25
110
111For versions of pb up to 0.14:
112An own format was used - The version of the configuration files is 0
113
114key tag = value1,value2,...
115
116Supposing the file is called "$ENV{'HOME'}/.pbrc", containing the following:
117
118  $ cat $HOME/.pbrc
119  pbver pb = 3
120  pbver default = 1
121  pblist pb = 12,25
122
123calling it like this:
124
125  my ($k1, $k2) = pb_conf_read_if("$ENV{'HOME'}/.pbrc","pbver","pblist");
126
127will allow to get the mapping:
128
129  $k1->{'pb'}  contains 3
130  $k1->{'default'} contains 1
131  $k2->{'pb'} contains 12,25
132
133Valid chars for keys and tags are letters, numbers, '-' and '_'.
134
135=over 4
136
137=item B<pb_conf_init>
138
139This function setup the environment PBPROJ for project-builder function usage from other projects.
140The first parameter is the project name.
141It sets up environment variables (PBPROJ)
142
143=cut
144
145sub pb_conf_init {
146
147my $proj=shift;
148
149pb_log(1,"Entering pb_conf_init\n");
150#
151# Check project name
152# Could be with env var PBPROJ
153# or option -p
154# if not defined take the first in conf file
155#
156if ((defined $ENV{'PBPROJ'}) &&
157    (not defined $proj)) {
158    pb_log(2,"PBPROJ env var setup ($ENV{'PBPROJ'}) so using it\n");
159    $proj = $ENV{'PBPROJ'};
160}
161
162if (defined $proj) {
163    $ENV{'PBPROJ'} = $proj;
164} else {
165    $ENV{'PBPROJ'} = "default";
166}
167pb_log(1,"PBPROJ = $ENV{'PBPROJ'}\n");
168}
169
170
171=item B<pb_conf_cache>
172
173This function caches the configuration file content passed as first parameter into the hash passed in second parameter
174It returns the modified hash
175Can be used in correlation with the %h hash to store permanently values or not if temporarily.
176
177=cut
178
179sub pb_conf_cache {
180
181my $cf = shift;
182my $lh = shift;
183
184my $ldfunc;
185
186# Read the content of the config file and cache it in the %h hash then available for queries
187if ($confver < 0.15) {
188    open(CONF,$cf) || confess "Unable to open $cf";
189    # This is the original conf file format for versions up to 0.14
190    while(<CONF>) {
191        next if (/^#/);
192        if (/^\s*([A-z0-9-_.]+)\s+([[A-z0-9-_.\?\[\]\*\+\\]+)\s*=\s*(.*)$/) {
193            pb_log(3,"DEBUG: 1:$1 2:$2 3:$3\n");
194            $lh->{$1}->{$2}=$3;
195        }
196    }
197    close(CONF);
198} else {
199    eval {
200        require YAML;
201        YAML->import();
202    };
203    if ($@) {
204        eval {
205            # No YAML found using a more std but less complete one. Old perl only
206            require Module::Build::YAML;
207            Module::Build::YAML->import();
208        };
209        if ($@) {
210            die "Unable to handle YAML configuration files without a YAML.pm module\n";
211        } else {
212            $ldfunc = \&Module::Build::YAML::LoadFile;
213        }
214    } else {
215        $ldfunc = \&YAML::LoadFile;
216    }
217
218    $lh = $ldfunc->($cf);
219}
220return($lh);
221}
222
223=item B<pb_conf_add>
224
225This function adds the configuration file to the list last, and cache their content in the %h hash
226
227=cut
228
229sub pb_conf_add {
230
231pb_log(2,"DEBUG: pb_conf_add with ".Dumper(@_)."\n");
232my $lh;
233
234foreach my $cf (@_) {
235    if (! -r $cf) {
236        pb_log(0,"WARNING: pb_conf_add can not read $cf\n");
237        next;
238    }
239    # Skip already used conf files
240    return($lh) if (defined $pbconffiles{$cf});
241   
242    # The new conf file overload values already managed
243    my $num = keys %pbconffiles;
244    pb_log(2,"DEBUG: pb_conf_cache of $cf at position $num\n");
245    $pbconffiles{$cf} = $num;
246
247    # Read the content of the config file
248    $lh = pb_conf_cache($cf,$lh);
249    # and cache it in the %h hash for further queries but after the previous
250    # as we load conf files in reverse order (most precise first)
251    pb_conf_add_last_in_hash($lh)
252}
253}
254
255
256=item B<pb_conf_read_if>
257
258This function returns a table of pointers on hashes
259corresponding to the keys in a configuration file passed in parameter.
260If that file doesn't exist, it returns undef.
261
262The file read is forgotten after its usage. If you want permanent caching of the data, use pb_conf_add then pb_conf_get
263
264=cut
265
266sub pb_conf_read_if {
267
268my $conffile = shift;
269my @param = @_;
270
271open(CONF,$conffile) || return((undef));
272close(CONF);
273return(pb_conf_read($conffile,@param));
274}
275
276=item B<pb_conf_read>
277
278This function is similar to B<pb_conf_read_if> except that it dies when the file in parameter doesn't exist.
279
280=cut
281
282sub pb_conf_read {
283
284my $conffile = shift;
285my @param = @_;
286my @ptr;
287my $lh;
288
289$lh = pb_conf_cache($conffile,$lh);
290
291foreach my $param (@param) {
292    push @ptr,$lh->{$param};
293}
294return(@ptr);
295}
296
297=item B<pb_conf_write>
298
299This function writes in the file passed ias first parameter the hash of values passed as second parameter
300
301=cut
302
303sub pb_conf_write {
304
305my $conffile = shift;
306my $h = shift;
307my $dpfunc;
308
309confess "No configuration file defined to write into !" if (not defined $conffile);
310confess "No hash defined to read from !" if (not defined $h);
311open(CONF,"> $conffile") || confess "Unable to write into $conffile";
312
313if ($confver < 0.15) {
314    # This is the original conf file format for versions up to 0.14
315    foreach my $p (sort keys %$h) {
316        my $j = $h->{$p};
317        foreach my $k (sort keys %$j) {
318            print CONF "$p $k = $j->{$k}\n";
319        }
320    }
321} else {
322    # This is the new YAML format
323    eval {
324        require YAML;
325        YAML->import();
326    };
327    if ($@) {
328        eval {
329            # No YAML found using a more std but less complete one. Old perl only
330            require Module::Build::YAML;
331            Module::Build::YAML->import();
332        };
333        if ($@) {
334            die "Unable to handle YAML configuration files without a YAML.pm module\n";
335        } else {
336            $dpfunc = \&Module::Build::YAML::Dump;
337        }
338    } else {
339        $dpfunc = \&YAML::Dump;
340    }
341
342    print CONF $dpfunc->($h);
343}
344close(CONF);
345}
346
347
348
349=item B<pb_conf_get_in_hash_if>
350
351This function returns a table, corresponding to a set of values queried in the hash passed in parameter or undef if it doesn't exist.
352It takes a table of keys as an input parameter.
353
354=cut
355
356sub pb_conf_get_in_hash_if {
357
358my $lh = shift || return(());
359my @params = @_;
360my @ptr = ();
361
362pb_log(2,"DEBUG: pb_conf_get_in_hash_if on params ".join(' ',@params)."\n");
363foreach my $k (@params) {
364    push @ptr,$lh->{$k};
365}
366
367pb_log(2,"DEBUG: pb_conf_get_in_hash_if returns\n".Dumper(@ptr));
368return(@ptr);
369}
370
371
372
373=item B<pb_conf_get_if>
374
375This 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.
376
377=cut
378
379sub pb_conf_get_if {
380
381my @param = @_;
382my @return = pb_conf_get_in_hash_if($h,@_);
383my $proj = undef;
384
385if (not defined $ENV{'PBPROJ'}) {
386    $proj = "unknown";
387} else {
388    $proj = $ENV{'PBPROJ'};
389}
390
391foreach my $i (0..$#param) {
392    if (not defined $return[$i]->{$proj}) {
393        $return[$i]->{$proj} = $return[$i]->{'default'} if (defined $return[$i]->{'default'});
394    }
395}
396return(@return);
397}
398
399=item B<pb_conf_add_last_in_hash>
400
401This 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)
402
403It is used internally by pb_conf_add and is not exported.
404
405=cut
406
407sub pb_conf_add_last_in_hash {
408
409my $ptr = shift;
410
411return if (not defined $ptr);
412# TODO: test $ptr is a hash pointer
413
414# When called without correct initialization, try to work anyway with default as project
415pb_conf_init("default") if (not defined $ENV{'PBPROJ'});
416
417my @params = (sort keys %$ptr);
418
419# Everything is returned via @h
420# @h contains the values overloading what @ptr may contain.
421my @h = pb_conf_get_in_hash_if($h,@params);
422my @ptr = pb_conf_get_in_hash_if($ptr,@params);
423
424my $p1;
425my $p2;
426
427pb_log(2,"DEBUG: pb_conf_add_last_in_hash params: ".Dumper(@params)."\n");
428pb_log(2,"DEBUG: pb_conf_add_last_in_hash current hash: ".Dumper(@h)."\n");
429pb_log(2,"DEBUG: pb_conf_add_last_in_hash new inputs: ".Dumper(@ptr)."\n");
430
431foreach my $i (0..$#params) {
432    $p1 = $h[$i];
433    $p2 = $ptr[$i];
434    # Always try to take the param from h in priority
435    # in order to mask what could be defined already in ptr
436    if (not defined $p2) {
437        # exit if no p1 either
438        next if (not defined $p1);
439    } else {
440        # Ref found in p2
441        if (not defined $p1) {
442            # No ref in p1 so use p2's value
443            $p1 = $p2;
444        } else {
445            # Both are defined - handling the overloading
446            # Now copy back into p1 all p2 content
447            # as p1 content always has priority over p2
448            if (not defined $p1->{$ENV{'PBPROJ'}}) {
449                if (defined $p2->{$ENV{'PBPROJ'}}) {
450                    $p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}};
451                }
452            }
453            # Now copy back into p1 all p2 content which doesn't exist in p1
454            # # p1 content always has priority over p2
455            foreach my $k (keys %$p2) {
456                $p1->{$k} = $p2->{$k} if (not defined $p1->{$k});
457            }
458        }
459    }
460    $h->{$params[$i]} = $p1;
461}
462pb_log(2,"DEBUG: pb_conf_add_last_in_hash output: ".Dumper($h)."\n");
463}
464
465=item B<pb_conf_get>
466
467This function is the same B<pb_conf_get_if>, except that it tests each returned value as they need to exist in that case.
468
469=cut
470
471sub pb_conf_get {
472
473my @param = @_;
474my @return = pb_conf_get_if(@param);
475my $proj = undef;
476
477if (not defined $ENV{'PBPROJ'}) {
478    $proj = "unknown";
479} else {
480    $proj = $ENV{'PBPROJ'};
481}
482
483confess "No params found for $proj" if (not @return);
484
485foreach my $i (0..$#param) {
486    confess "No $param[$i] defined for $proj" if (not defined $return[$i]);
487}
488return(@return);
489}
490
491
492=item B<pb_conf_get_all>
493
494This function returns an array with all configuration parameters
495
496=cut
497
498sub pb_conf_get_all {
499
500return(sort keys %$h);
501}
502
503
504=item B<pb_conf_get_hash>
505
506This function returns a pointer to the hash with all configuration parameters
507
508=cut
509
510sub pb_conf_get_hash {
511
512return($h);
513}
514
515=back
516
517=head1 WEB SITES
518
519The 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/>.
520
521=head1 USER MAILING LIST
522
523None exists for the moment.
524
525=head1 AUTHORS
526
527The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
528
529=head1 COPYRIGHT
530
531Project-Builder.org is distributed under the GPL v2.0 license
532described in the file C<COPYING> included with the distribution.
533
534=cut
535
536
5371;
Note: See TracBrowser for help on using the repository browser.