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

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

Log when handling YAML conf files the filename

Fix also temp pbrc.yml generation in pb

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