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

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

Automate convversion of pburl into pbprojurl in update_v0 and add an error if pbconfurl not found

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