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

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

Add support for conf file value being empty strings

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