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
RevLine 
[405]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#
[2032]7# Copyright B. Cornec 2007-2016
[1528]8# Eric Anderson's changes are (c) Copyright 2012 Hewlett Packard
9# Provided under the GPL v2
10#
[405]11# $Id$
12#
13
14package ProjectBuilder::Conf;
15
16use strict;
[1507]17use Carp 'confess';
[405]18use Data::Dumper;
19use ProjectBuilder::Base;
[1148]20use ProjectBuilder::Version;
[2241]21#use YAML;
[405]22
23# Inherit from the "Exporter" module which handles exporting functions.
24 
[2241]25use vars qw($VERSION $REVISION @ISA @EXPORT);
[405]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);
[2254]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();
[405]34
[898]35# Global hash of conf files
36# Key is the conf file name
37# Value is its rank
38my %pbconffiles;
[409]39
[1495]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
[898]44# We consider that values can not change during the life of pb
[1495]45my $h = ();
[898]46
[405]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  #
[2252]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");
[405]66
67=head1 USAGE
68
[2152]69The configuration files are loaded in a specific order from most generic to the most specific
70to allow for overwrite to work:
71
[2250]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:
[2241]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
[2152]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
[2250]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
[2257]94  ---
[2250]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
[405]135=over 4
136
[505]137=item B<pb_conf_init>
138
[898]139This function setup the environment PBPROJ for project-builder function usage from other projects.
[505]140The first parameter is the project name.
[898]141It sets up environment variables (PBPROJ)
[505]142
143=cut
144
145sub pb_conf_init {
146
[1907]147my $proj=shift;
[505]148
[1495]149pb_log(1,"Entering pb_conf_init\n");
[1584]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
[505]162if (defined $proj) {
163    $ENV{'PBPROJ'} = $proj;
164} else {
165    $ENV{'PBPROJ'} = "default";
166}
[1495]167pb_log(1,"PBPROJ = $ENV{'PBPROJ'}\n");
[505]168}
169
170
[1495]171=item B<pb_conf_cache>
[505]172
[2250]173This function caches the configuration file content passed as first parameter into the hash passed in second parameter
[1495]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
[2249]184my $ldfunc;
185
[2077]186# Read the content of the config file and cache it in the %h hash then available for queries
[2241]187if ($confver < 0.15) {
[2176]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");
[2253]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();
[2256]207            warn "unexpected line '$_' in $cf";
[2176]208        }
[1495]209    }
[2176]210    close(CONF);
211} else {
[2249]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
[2261]231    pb_log(1,"Loading YAML conf file $cf\n");
[2249]232    $lh = $ldfunc->($cf);
[1495]233}
234return($lh);
235}
236
[409]237=item B<pb_conf_add>
238
[1495]239This function adds the configuration file to the list last, and cache their content in the %h hash
[409]240
241=cut
242
243sub pb_conf_add {
244
[415]245pb_log(2,"DEBUG: pb_conf_add with ".Dumper(@_)."\n");
[1495]246my $lh;
[898]247
248foreach my $cf (@_) {
[1495]249    if (! -r $cf) {
250        pb_log(0,"WARNING: pb_conf_add can not read $cf\n");
251        next;
252    }
[898]253    # Skip already used conf files
[1495]254    return($lh) if (defined $pbconffiles{$cf});
255   
[2154]256    # The new conf file overload values already managed
[898]257    my $num = keys %pbconffiles;
[1495]258    pb_log(2,"DEBUG: pb_conf_cache of $cf at position $num\n");
[898]259    $pbconffiles{$cf} = $num;
[1495]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)
[409]266}
[898]267}
[409]268
[1495]269
[405]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
[1495]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
[405]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;
[1495]301my $lh;
[405]302
[1495]303$lh = pb_conf_cache($conffile,$lh);
304
305foreach my $param (@param) {
306    push @ptr,$lh->{$param};
[405]307}
[1495]308return(@ptr);
309}
[405]310
[1904]311=item B<pb_conf_write>
[1495]312
[1904]313This function writes in the file passed ias first parameter the hash of values passed as second parameter
[1495]314
[1904]315=cut
316
317sub pb_conf_write {
318
319my $conffile = shift;
[1905]320my $h = shift;
[2249]321my $dpfunc;
[1904]322
[1905]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";
[1904]326
[2241]327if ($confver < 0.15) {
[2176]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        }
[1904]334    }
[2176]335} else {
336    # This is the new YAML format
[2249]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
[2261]356    pb_log(1,"Writing YAML conf file $conffile\n");
[2249]357    print CONF $dpfunc->($h);
[1904]358}
359close(CONF);
360}
361
362
363
[1495]364=item B<pb_conf_get_in_hash_if>
365
[1594]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.
[1495]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};
[405]380}
[1495]381
382pb_log(2,"DEBUG: pb_conf_get_in_hash_if returns\n".Dumper(@ptr));
[405]383return(@ptr);
384}
385
[1495]386
387
[409]388=item B<pb_conf_get_if>
[405]389
[1495]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.
[405]391
[409]392=cut
393
394sub pb_conf_get_if {
395
[2154]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'};
[405]404}
[409]405
[2154]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
[1495]414=item B<pb_conf_add_last_in_hash>
[405]415
[1495]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)
[405]417
[1495]418It is used internally by pb_conf_add and is not exported.
[409]419
420=cut
421
[1495]422sub pb_conf_add_last_in_hash {
[409]423
[1907]424my $ptr = shift;
[409]425
[1495]426return if (not defined $ptr);
427# TODO: test $ptr is a hash pointer
[405]428
[1509]429# When called without correct initialization, try to work anyway with default as project
430pb_conf_init("default") if (not defined $ENV{'PBPROJ'});
431
[1495]432my @params = (sort keys %$ptr);
[405]433
[1495]434# Everything is returned via @h
435# @h contains the values overloading what @ptr may contain.
[2154]436my @h = pb_conf_get_in_hash_if($h,@params);
[1495]437my @ptr = pb_conf_get_in_hash_if($ptr,@params);
[409]438
[405]439my $p1;
440my $p2;
441
[1495]442pb_log(2,"DEBUG: pb_conf_add_last_in_hash params: ".Dumper(@params)."\n");
[2154]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");
[405]445
[1495]446foreach my $i (0..$#params) {
447    $p1 = $h[$i];
448    $p2 = $ptr[$i];
[2154]449    # Always try to take the param from h in priority
[1495]450    # in order to mask what could be defined already in ptr
[405]451    if (not defined $p2) {
[415]452        # exit if no p1 either
[1509]453        next if (not defined $p1);
[405]454    } else {
[409]455        # Ref found in p2
[405]456        if (not defined $p1) {
[409]457            # No ref in p1 so use p2's value
[405]458            $p1 = $p2;
459        } else {
460            # Both are defined - handling the overloading
[2154]461            # Now copy back into p1 all p2 content
462            # as p1 content always has priority over p2
[405]463            if (not defined $p1->{$ENV{'PBPROJ'}}) {
464                if (defined $p2->{$ENV{'PBPROJ'}}) {
[1594]465                    $p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}};
[405]466                }
467            }
468            # Now copy back into p1 all p2 content which doesn't exist in p1
[2154]469            # # p1 content always has priority over p2
[405]470            foreach my $k (keys %$p2) {
471                $p1->{$k} = $p2->{$k} if (not defined $p1->{$k});
472            }
473        }
474    }
[1495]475    $h->{$params[$i]} = $p1;
[405]476}
[1495]477pb_log(2,"DEBUG: pb_conf_add_last_in_hash output: ".Dumper($h)."\n");
[405]478}
479
[409]480=item B<pb_conf_get>
[405]481
[409]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);
[932]490my $proj = undef;
[409]491
[932]492if (not defined $ENV{'PBPROJ'}) {
493    $proj = "unknown";
494} else {
495    $proj = $ENV{'PBPROJ'};
496}
[409]497
[1538]498confess "No params found for $proj" if (not @return);
[932]499
[409]500foreach my $i (0..$#param) {
[1507]501    confess "No $param[$i] defined for $proj" if (not defined $return[$i]);
[409]502}
503return(@return);
504}
505
[1495]506
[1694]507=item B<pb_conf_get_all>
508
[2077]509This function returns an array with all configuration parameters
[1694]510
511=cut
512
513sub pb_conf_get_all {
514
515return(sort keys %$h);
516}
517
[2077]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
[2253]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";
[2257]544print DEST "---\n";
[2253]545my $pbconfverbkp = $PBCONFVER;
546# We force migration from v0 to v1
547$PBCONFVER = 0;
548my $lh0;
[2257]549my $lh1;
[2253]550$lh0 = pb_conf_cache($orig,$lh0);
[2257]551pb_log(2,"lh0:\n",Dumper($lh0),"\n");
[2253]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 $_;
[2257]559    } elsif ($_ =~ /^\s*$/) {
560        # Replace empty lines by comments
561        print DEST "#\n";;
[2253]562    } else {
563        if (/^\s*([A-z0-9-_]+)\s+(.+)$/) {
564            # Handle parameters
[2257]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            }
[2253]575        } else {
[2257]576            pb_log(0,"Unable to convert line $_\n");
[2253]577        }
578    }
579}
580close(ORIG);
581close(DEST);
582return();
583}
584
[405]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.