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

Last change on this file since 2254 was 2254, checked in by bruno, 23 months ago

Automatically modify v0 filter files into v1 format

File size: 14.3 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 pb_conf_update_v0);
33($VERSION,$REVISION,$PBCONFVER) = 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.yml","key1","key2");
65  my ($k) = pb_conf_read("$ENV{'HOME'}/.pbrc.yml","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  --- %YAML 1.0
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            my ($what, $var, $value) = ($1, $2, $3);
195            # Add support for multi-lines
196            while ($value =~ s/\\\s*$//o) {
197                $_ = <CONF>;
198                die "Still processing continuations for $what $var at EOF" if (not defined $_);
199                s/[\r\n]//go;
200                $value .= "\n$_";
201            }
202            $lh->{$what}->{$var}=$value;
203        } elsif ((/^\s*#/o) || (/^\s*$/o)) {
204            # ignore
205        } else {
206            chomp();
207            warn "unexpected line '$_' in $f";
208        }
209    }
210    close(CONF);
211} else {
212    eval {
213        require YAML;
214        YAML->import();
215    };
216    if ($@) {
217        eval {
218            # No YAML found using a more std but less complete one. Old perl only
219            require Module::Build::YAML;
220            Module::Build::YAML->import();
221        };
222        if ($@) {
223            die "Unable to handle YAML configuration files without a YAML.pm module\n";
224        } else {
225            $ldfunc = \&Module::Build::YAML::LoadFile;
226        }
227    } else {
228        $ldfunc = \&YAML::LoadFile;
229    }
230
231    $lh = $ldfunc->($cf);
232}
233return($lh);
234}
235
236=item B<pb_conf_add>
237
238This function adds the configuration file to the list last, and cache their content in the %h hash
239
240=cut
241
242sub pb_conf_add {
243
244pb_log(2,"DEBUG: pb_conf_add with ".Dumper(@_)."\n");
245my $lh;
246
247foreach my $cf (@_) {
248    if (! -r $cf) {
249        pb_log(0,"WARNING: pb_conf_add can not read $cf\n");
250        next;
251    }
252    # Skip already used conf files
253    return($lh) if (defined $pbconffiles{$cf});
254   
255    # The new conf file overload values already managed
256    my $num = keys %pbconffiles;
257    pb_log(2,"DEBUG: pb_conf_cache of $cf at position $num\n");
258    $pbconffiles{$cf} = $num;
259
260    # Read the content of the config file
261    $lh = pb_conf_cache($cf,$lh);
262    # and cache it in the %h hash for further queries but after the previous
263    # as we load conf files in reverse order (most precise first)
264    pb_conf_add_last_in_hash($lh)
265}
266}
267
268
269=item B<pb_conf_read_if>
270
271This function returns a table of pointers on hashes
272corresponding to the keys in a configuration file passed in parameter.
273If that file doesn't exist, it returns undef.
274
275The file read is forgotten after its usage. If you want permanent caching of the data, use pb_conf_add then pb_conf_get
276
277=cut
278
279sub pb_conf_read_if {
280
281my $conffile = shift;
282my @param = @_;
283
284open(CONF,$conffile) || return((undef));
285close(CONF);
286return(pb_conf_read($conffile,@param));
287}
288
289=item B<pb_conf_read>
290
291This function is similar to B<pb_conf_read_if> except that it dies when the file in parameter doesn't exist.
292
293=cut
294
295sub pb_conf_read {
296
297my $conffile = shift;
298my @param = @_;
299my @ptr;
300my $lh;
301
302$lh = pb_conf_cache($conffile,$lh);
303
304foreach my $param (@param) {
305    push @ptr,$lh->{$param};
306}
307return(@ptr);
308}
309
310=item B<pb_conf_write>
311
312This function writes in the file passed ias first parameter the hash of values passed as second parameter
313
314=cut
315
316sub pb_conf_write {
317
318my $conffile = shift;
319my $h = shift;
320my $dpfunc;
321
322confess "No configuration file defined to write into !" if (not defined $conffile);
323confess "No hash defined to read from !" if (not defined $h);
324open(CONF,"> $conffile") || confess "Unable to write into $conffile";
325
326if ($confver < 0.15) {
327    # This is the original conf file format for versions up to 0.14
328    foreach my $p (sort keys %$h) {
329        my $j = $h->{$p};
330        foreach my $k (sort keys %$j) {
331            print CONF "$p $k = $j->{$k}\n";
332        }
333    }
334} else {
335    # This is the new YAML format
336    eval {
337        require YAML;
338        YAML->import();
339    };
340    if ($@) {
341        eval {
342            # No YAML found using a more std but less complete one. Old perl only
343            require Module::Build::YAML;
344            Module::Build::YAML->import();
345        };
346        if ($@) {
347            die "Unable to handle YAML configuration files without a YAML.pm module\n";
348        } else {
349            $dpfunc = \&Module::Build::YAML::Dump;
350        }
351    } else {
352        $dpfunc = \&YAML::Dump;
353    }
354
355    print CONF $dpfunc->($h);
356}
357close(CONF);
358}
359
360
361
362=item B<pb_conf_get_in_hash_if>
363
364This function returns a table, corresponding to a set of values queried in the hash passed in parameter or undef if it doesn't exist.
365It takes a table of keys as an input parameter.
366
367=cut
368
369sub pb_conf_get_in_hash_if {
370
371my $lh = shift || return(());
372my @params = @_;
373my @ptr = ();
374
375pb_log(2,"DEBUG: pb_conf_get_in_hash_if on params ".join(' ',@params)."\n");
376foreach my $k (@params) {
377    push @ptr,$lh->{$k};
378}
379
380pb_log(2,"DEBUG: pb_conf_get_in_hash_if returns\n".Dumper(@ptr));
381return(@ptr);
382}
383
384
385
386=item B<pb_conf_get_if>
387
388This 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.
389
390=cut
391
392sub pb_conf_get_if {
393
394my @param = @_;
395my @return = pb_conf_get_in_hash_if($h,@_);
396my $proj = undef;
397
398if (not defined $ENV{'PBPROJ'}) {
399    $proj = "unknown";
400} else {
401    $proj = $ENV{'PBPROJ'};
402}
403
404foreach my $i (0..$#param) {
405    if (not defined $return[$i]->{$proj}) {
406        $return[$i]->{$proj} = $return[$i]->{'default'} if (defined $return[$i]->{'default'});
407    }
408}
409return(@return);
410}
411
412=item B<pb_conf_add_last_in_hash>
413
414This 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)
415
416It is used internally by pb_conf_add and is not exported.
417
418=cut
419
420sub pb_conf_add_last_in_hash {
421
422my $ptr = shift;
423
424return if (not defined $ptr);
425# TODO: test $ptr is a hash pointer
426
427# When called without correct initialization, try to work anyway with default as project
428pb_conf_init("default") if (not defined $ENV{'PBPROJ'});
429
430my @params = (sort keys %$ptr);
431
432# Everything is returned via @h
433# @h contains the values overloading what @ptr may contain.
434my @h = pb_conf_get_in_hash_if($h,@params);
435my @ptr = pb_conf_get_in_hash_if($ptr,@params);
436
437my $p1;
438my $p2;
439
440pb_log(2,"DEBUG: pb_conf_add_last_in_hash params: ".Dumper(@params)."\n");
441pb_log(2,"DEBUG: pb_conf_add_last_in_hash current hash: ".Dumper(@h)."\n");
442pb_log(2,"DEBUG: pb_conf_add_last_in_hash new inputs: ".Dumper(@ptr)."\n");
443
444foreach my $i (0..$#params) {
445    $p1 = $h[$i];
446    $p2 = $ptr[$i];
447    # Always try to take the param from h in priority
448    # in order to mask what could be defined already in ptr
449    if (not defined $p2) {
450        # exit if no p1 either
451        next if (not defined $p1);
452    } else {
453        # Ref found in p2
454        if (not defined $p1) {
455            # No ref in p1 so use p2's value
456            $p1 = $p2;
457        } else {
458            # Both are defined - handling the overloading
459            # Now copy back into p1 all p2 content
460            # as p1 content always has priority over p2
461            if (not defined $p1->{$ENV{'PBPROJ'}}) {
462                if (defined $p2->{$ENV{'PBPROJ'}}) {
463                    $p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}};
464                }
465            }
466            # Now copy back into p1 all p2 content which doesn't exist in p1
467            # # p1 content always has priority over p2
468            foreach my $k (keys %$p2) {
469                $p1->{$k} = $p2->{$k} if (not defined $p1->{$k});
470            }
471        }
472    }
473    $h->{$params[$i]} = $p1;
474}
475pb_log(2,"DEBUG: pb_conf_add_last_in_hash output: ".Dumper($h)."\n");
476}
477
478=item B<pb_conf_get>
479
480This function is the same B<pb_conf_get_if>, except that it tests each returned value as they need to exist in that case.
481
482=cut
483
484sub pb_conf_get {
485
486my @param = @_;
487my @return = pb_conf_get_if(@param);
488my $proj = undef;
489
490if (not defined $ENV{'PBPROJ'}) {
491    $proj = "unknown";
492} else {
493    $proj = $ENV{'PBPROJ'};
494}
495
496confess "No params found for $proj" if (not @return);
497
498foreach my $i (0..$#param) {
499    confess "No $param[$i] defined for $proj" if (not defined $return[$i]);
500}
501return(@return);
502}
503
504
505=item B<pb_conf_get_all>
506
507This function returns an array with all configuration parameters
508
509=cut
510
511sub pb_conf_get_all {
512
513return(sort keys %$h);
514}
515
516
517=item B<pb_conf_get_hash>
518
519This function returns a pointer to the hash with all configuration parameters
520
521=cut
522
523sub pb_conf_get_hash {
524
525return($h);
526}
527
528=item B<pb_conf_update_v0>
529
530This function transform the old configuration v0 file as first param into a new v1 one as second param
531
532=cut
533
534sub pb_conf_update_v0 {
535
536my $orig = shift;
537my $dest = shift;
538
539open(ORIG,$orig) || confess "Unable to open $orig";
540confess "Will not erase existing $dest while transforming $orig" if (-f $dest);
541open(DEST,"> $dest") || confess "Unable to write into $dest";
542print DEST "--- %YAML 1.0\n";
543my $parambkp = "";
544my $pbconfverbkp = $PBCONFVER;
545# We force migration from v0 to v1
546$PBCONFVER = 0;
547my $lh0;
548$lh0 = pb_conf_cache($orig,$lh0);
549$PBCONFVER = $pbconfverbkp;
550
551# We can't just write the YAML if we want to ckeep comments !
552while (<ORIG>) {
553    if ($_ =~ /^#/) {
554        # Keep comments
555        print DEST $_;
556    } else {
557        if (/^\s*([A-z0-9-_]+)\s+(.+)$/) {
558            # Handle parameters
559            my ($param,$void) = ($1, $2);
560            print DEST "  $param:\n" if ($param ne $parambkp);
561            print DEST "    $lh0->{$param} $lh0->{$param}->{$var}\n";
562            $parambkp = $param;
563        } else {
564            pb_log(0,"Unable to handle line $_\n");
565        }
566    }
567}
568close(ORIG);
569close(DEST);
570return();
571}
572
573=back
574
575=head1 WEB SITES
576
577The 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/>.
578
579=head1 USER MAILING LIST
580
581None exists for the moment.
582
583=head1 AUTHORS
584
585The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
586
587=head1 COPYRIGHT
588
589Project-Builder.org is distributed under the GPL v2.0 license
590described in the file C<COPYING> included with the distribution.
591
592=cut
593
594
5951;
Note: See TracBrowser for help on using the repository browser.