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

Last change on this file since 2397 was 2397, checked in by bruno, 3 months ago

closing a file before returning

File size: 15.1 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;
[2362]17use Carp qw/cluck confess/;
[405]18use Data::Dumper;
19use ProjectBuilder::Base;
[1148]20use ProjectBuilder::Version;
[405]21
22# Inherit from the "Exporter" module which handles exporting functions.
23 
[2279]24use vars qw($VERSION $REVISION $PBCONFVER @ISA @EXPORT);
[405]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);
[2254]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();
[405]33
[898]34# Global hash of conf files
35# Key is the conf file name
36# Value is its rank
37my %pbconffiles;
[409]38
[1495]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
[898]43# We consider that values can not change during the life of pb
[1495]44my $h = ();
[898]45
[405]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  #
[2252]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");
[405]65
66=head1 USAGE
67
[2152]68The configuration files are loaded in a specific order from most generic to the most specific
69to allow for overwrite to work:
70
[2250]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:
[2241]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
[2152]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
[2250]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
[2257]93  ---
[2250]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
[405]134=over 4
135
[505]136=item B<pb_conf_init>
137
[898]138This function setup the environment PBPROJ for project-builder function usage from other projects.
[505]139The first parameter is the project name.
[898]140It sets up environment variables (PBPROJ)
[505]141
142=cut
143
144sub pb_conf_init {
145
[1907]146my $proj=shift;
[505]147
[1495]148pb_log(1,"Entering pb_conf_init\n");
[1584]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
[505]161if (defined $proj) {
162    $ENV{'PBPROJ'} = $proj;
163} else {
164    $ENV{'PBPROJ'} = "default";
165}
[1495]166pb_log(1,"PBPROJ = $ENV{'PBPROJ'}\n");
[505]167}
168
169
[1495]170=item B<pb_conf_cache>
[505]171
[2250]172This function caches the configuration file content passed as first parameter into the hash passed in second parameter
[1495]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
[2249]183my $ldfunc;
184
[2077]185# Read the content of the config file and cache it in the %h hash then available for queries
[2279]186if ($PBCONFVER < 1) {
[2362]187    open(CONF,$cf) || cluck "Unable to open $cf" && return($lh);
[2176]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");
[2253]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();
[2256]206            warn "unexpected line '$_' in $cf";
[2176]207        }
[1495]208    }
[2176]209    close(CONF);
210} else {
[2249]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
[2261]230    pb_log(1,"Loading YAML conf file $cf\n");
[2263]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    }
[1495]241}
242return($lh);
243}
244
[409]245=item B<pb_conf_add>
246
[1495]247This function adds the configuration file to the list last, and cache their content in the %h hash
[409]248
249=cut
250
251sub pb_conf_add {
252
[415]253pb_log(2,"DEBUG: pb_conf_add with ".Dumper(@_)."\n");
[1495]254my $lh;
[898]255
256foreach my $cf (@_) {
[1495]257    if (! -r $cf) {
258        pb_log(0,"WARNING: pb_conf_add can not read $cf\n");
259        next;
260    }
[898]261    # Skip already used conf files
[1495]262    return($lh) if (defined $pbconffiles{$cf});
263   
[2154]264    # The new conf file overload values already managed
[898]265    my $num = keys %pbconffiles;
[1495]266    pb_log(2,"DEBUG: pb_conf_cache of $cf at position $num\n");
[898]267    $pbconffiles{$cf} = $num;
[1495]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)
[409]274}
[898]275}
[409]276
[1495]277
[405]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
[1495]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
[405]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;
[1495]309my $lh;
[405]310
[1495]311$lh = pb_conf_cache($conffile,$lh);
312
313foreach my $param (@param) {
314    push @ptr,$lh->{$param};
[405]315}
[1495]316return(@ptr);
317}
[405]318
[1904]319=item B<pb_conf_write>
[1495]320
[2278]321This function writes in the file passed as first parameter the hash of values passed as second parameter
[1495]322
[1904]323=cut
324
325sub pb_conf_write {
326
327my $conffile = shift;
[1905]328my $h = shift;
[2249]329my $dpfunc;
[1904]330
[1905]331confess "No configuration file defined to write into !" if (not defined $conffile);
332confess "No hash defined to read from !" if (not defined $h);
[2362]333open(CONF,"> $conffile") || cluck "Unable to write into $conffile" && return;
[1904]334
[2279]335if ($PBCONFVER < 1) {
[2176]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        }
[1904]342    }
[2176]343} else {
344    # This is the new YAML format
[2249]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
[2261]364    pb_log(1,"Writing YAML conf file $conffile\n");
[2249]365    print CONF $dpfunc->($h);
[1904]366}
367close(CONF);
368}
369
370
371
[1495]372=item B<pb_conf_get_in_hash_if>
373
[1594]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.
[1495]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};
[405]388}
[1495]389
390pb_log(2,"DEBUG: pb_conf_get_in_hash_if returns\n".Dumper(@ptr));
[405]391return(@ptr);
392}
393
[1495]394
395
[409]396=item B<pb_conf_get_if>
[405]397
[1495]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.
[405]399
[409]400=cut
401
402sub pb_conf_get_if {
403
[2154]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'};
[405]412}
[409]413
[2154]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
[1495]422=item B<pb_conf_add_last_in_hash>
[405]423
[1495]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)
[405]425
[1495]426It is used internally by pb_conf_add and is not exported.
[409]427
428=cut
429
[1495]430sub pb_conf_add_last_in_hash {
[409]431
[1907]432my $ptr = shift;
[409]433
[1495]434return if (not defined $ptr);
435# TODO: test $ptr is a hash pointer
[405]436
[1509]437# When called without correct initialization, try to work anyway with default as project
438pb_conf_init("default") if (not defined $ENV{'PBPROJ'});
439
[1495]440my @params = (sort keys %$ptr);
[405]441
[1495]442# Everything is returned via @h
443# @h contains the values overloading what @ptr may contain.
[2154]444my @h = pb_conf_get_in_hash_if($h,@params);
[1495]445my @ptr = pb_conf_get_in_hash_if($ptr,@params);
[409]446
[405]447my $p1;
448my $p2;
449
[1495]450pb_log(2,"DEBUG: pb_conf_add_last_in_hash params: ".Dumper(@params)."\n");
[2154]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");
[405]453
[1495]454foreach my $i (0..$#params) {
455    $p1 = $h[$i];
456    $p2 = $ptr[$i];
[2154]457    # Always try to take the param from h in priority
[1495]458    # in order to mask what could be defined already in ptr
[405]459    if (not defined $p2) {
[415]460        # exit if no p1 either
[1509]461        next if (not defined $p1);
[405]462    } else {
[409]463        # Ref found in p2
[405]464        if (not defined $p1) {
[409]465            # No ref in p1 so use p2's value
[405]466            $p1 = $p2;
467        } else {
468            # Both are defined - handling the overloading
[2154]469            # Now copy back into p1 all p2 content
470            # as p1 content always has priority over p2
[405]471            if (not defined $p1->{$ENV{'PBPROJ'}}) {
472                if (defined $p2->{$ENV{'PBPROJ'}}) {
[1594]473                    $p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}};
[405]474                }
475            }
476            # Now copy back into p1 all p2 content which doesn't exist in p1
[2154]477            # # p1 content always has priority over p2
[405]478            foreach my $k (keys %$p2) {
479                $p1->{$k} = $p2->{$k} if (not defined $p1->{$k});
480            }
481        }
482    }
[1495]483    $h->{$params[$i]} = $p1;
[405]484}
[1495]485pb_log(2,"DEBUG: pb_conf_add_last_in_hash output: ".Dumper($h)."\n");
[405]486}
487
[409]488=item B<pb_conf_get>
[405]489
[409]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);
[932]498my $proj = undef;
[409]499
[932]500if (not defined $ENV{'PBPROJ'}) {
501    $proj = "unknown";
502} else {
503    $proj = $ENV{'PBPROJ'};
504}
[409]505
[1538]506confess "No params found for $proj" if (not @return);
[932]507
[409]508foreach my $i (0..$#param) {
[1507]509    confess "No $param[$i] defined for $proj" if (not defined $return[$i]);
[409]510}
511return(@return);
512}
513
[1495]514
[1694]515=item B<pb_conf_get_all>
516
[2077]517This function returns an array with all configuration parameters
[1694]518
519=cut
520
521sub pb_conf_get_all {
522
523return(sort keys %$h);
524}
525
[2077]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
[2253]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
[2362]549open(ORIG,$orig) || cluck "Unable to open $orig" && return;
[2253]550confess "Will not erase existing $dest while transforming $orig" if (-f $dest);
[2397]551open(DEST,"> $dest") || cluck "Unable to write into $dest" && close(ORIG) && return;
[2257]552print DEST "---\n";
[2253]553my $pbconfverbkp = $PBCONFVER;
554# We force migration from v0 to v1
555$PBCONFVER = 0;
556my $lh0;
[2257]557my $lh1;
[2253]558$lh0 = pb_conf_cache($orig,$lh0);
[2263]559pb_log(2,"lh0:\n".Dumper($lh0)."\n");
[2253]560$PBCONFVER = $pbconfverbkp;
561
[2264]562pb_log(0,"Converting v0 conf file $orig to v1 conf file $dest\n");
[2253]563# We can't just write the YAML if we want to ckeep comments !
564while (<ORIG>) {
565    if ($_ =~ /^#/) {
566        # Keep comments
567        print DEST $_;
[2257]568    } elsif ($_ =~ /^\s*$/) {
569        # Replace empty lines by comments
570        print DEST "#\n";;
[2253]571    } else {
572        if (/^\s*([A-z0-9-_]+)\s+(.+)$/) {
573            # Handle parameters
[2257]574            my ($param,$void) = ($1, $2);
575            if (not defined $lh1->{$param}) {
576                pb_log(2,"Converting parameter $param\n");
[2300]577                my $param2 = $param;
578                # param pburl in v0 is now pbprojurl in v1
579                $param2 =~ s/pburl/pbprojurl/;
580                print DEST "$param2:\n";
[2257]581                foreach my $k (keys %{$lh0->{$param}}) {
582                    pb_log(2,"Handling key $k\n");
[2264]583                    if ($lh0->{$param}->{$k} =~ /^\s*$/) {
584                        print DEST "  $k: !!str \"\"\n";
585                    } else {
586                        print DEST "  $k: $lh0->{$param}->{$k}\n";
587                    }
[2257]588                }
589                $lh1->{$param} = 1;
590            }
[2253]591        } else {
[2257]592            pb_log(0,"Unable to convert line $_\n");
[2253]593        }
594    }
595}
596close(ORIG);
597close(DEST);
598return();
599}
600
[405]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.