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

Last change on this file since 2402 was 2402, checked in by bruno, 4 months ago

eval YAML LoadFile? to try to issue error messages and exit when error

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