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

Last change on this file since 1156 was 1156, checked in by bruno, 9 years ago
  • Adds a global variable REVISION for version management
  • Do not return in pb_send2target if pb file not available in order to shutdown VM in all cases
  • Code and test sbx2setupvm
  • setup_v now needs a fake pb_version_init fct added at the end of the script
  • Fix pbdistrocheck install comand printing
  • Fix mandralinux old distro build in pb.conf (Note only non symlink release files are important)
File size: 8.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# $Id$
8#
9
10package ProjectBuilder::Conf;
11
12use strict;
13use Data::Dumper;
14use ProjectBuilder::Base;
15use ProjectBuilder::Version;
16
17# Inherit from the "Exporter" module which handles exporting functions.
18 
19use vars qw($VERSION $REVISION @ISA @EXPORT);
20use Exporter;
21 
22# Export, by default, all the functions into the namespace of
23# any code which uses this module.
24 
25our @ISA = qw(Exporter);
26our @EXPORT = qw(pb_conf_init pb_conf_add pb_conf_read pb_conf_read_if pb_conf_get pb_conf_get_if);
27($VERSION,$REVISION) = pb_version_init();
28
29# Global hash of conf files
30# Key is the conf file name
31# Value is its rank
32my %pbconffiles;
33
34# Global hash of cached values.
35# We consider that values can not change during the life of pb
36# my %cachedval;
37
38=pod
39
40=head1 NAME
41
42ProjectBuilder::Conf, part of the project-builder.org - module dealing with configuration files
43
44=head1 DESCRIPTION
45
46This modules provides functions dealing with configuration files.
47
48=head1 SYNOPSIS
49
50  use ProjectBuilder::Conf;
51
52  #
53  # Read hash codes of values from a configuration file and return table of pointers
54  #
55  my ($k1, $k2) = pb_conf_read_if("$ENV{'HOME'}/.pbrc","key1","key2");
56  my ($k) = pb_conf_read("$ENV{'HOME'}/.pbrc","key");
57
58=head1 USAGE
59
60=over 4
61
62=item B<pb_conf_init>
63
64This function setup the environment PBPROJ for project-builder function usage from other projects.
65The first parameter is the project name.
66It sets up environment variables (PBPROJ)
67
68=cut
69
70sub pb_conf_init {
71
72my $proj=shift || undef;
73
74if (defined $proj) {
75    $ENV{'PBPROJ'} = $proj;
76} else {
77    $ENV{'PBPROJ'} = "default";
78}
79}
80
81
82
83=item B<pb_conf_add>
84
85This function adds the configuration file to the list last.
86
87=cut
88
89sub pb_conf_add {
90
91pb_log(2,"DEBUG: pb_conf_add with ".Dumper(@_)."\n");
92
93foreach my $cf (@_) {
94    # Skip already used conf files
95    next if (defined $pbconffiles{$cf});
96    # Add the new one at the end
97    my $num = keys %pbconffiles;
98    pb_log(2,"DEBUG: pb_conf_add $cf at position $num\n");
99    $pbconffiles{$cf} = $num;
100    pb_log(0,"WARNING: pb_conf_add can not read $cf\n") if (! -r $cf);
101}
102}
103
104=item B<pb_conf_read_if>
105
106This function returns a table of pointers on hashes
107corresponding to the keys in a configuration file passed in parameter.
108If that file doesn't exist, it returns undef.
109
110The format of the configuration file is as follows:
111
112key tag = value1,value2,...
113
114Supposing the file is called "$ENV{'HOME'}/.pbrc", containing the following:
115
116  $ cat $HOME/.pbrc
117  pbver pb = 3
118  pbver default = 1
119  pblist pb = 12,25
120
121calling it like this:
122
123  my ($k1, $k2) = pb_conf_read_if("$ENV{'HOME'}/.pbrc","pbver","pblist");
124
125will allow to get the mapping:
126
127  $k1->{'pb'}  contains 3
128  $k1->{'default'} contains 1
129  $k2->{'pb'} contains 12,25
130
131Valid chars for keys and tags are letters, numbers, '-' and '_'.
132
133=cut
134
135sub pb_conf_read_if {
136
137my $conffile = shift;
138my @param = @_;
139
140open(CONF,$conffile) || return((undef));
141close(CONF);
142return(pb_conf_read($conffile,@param));
143}
144
145=item B<pb_conf_read>
146
147This function is similar to B<pb_conf_read_if> except that it dies when the file in parameter doesn't exist.
148
149=cut
150
151sub pb_conf_read {
152
153my $conffile = shift;
154my @param = @_;
155my $trace;
156my @ptr;
157my %h;
158
159open(CONF,$conffile) || die "Unable to open $conffile";
160while(<CONF>) {
161    if (/^\s*([A-z0-9-_.]+)\s+([[A-z0-9-_.]+)\s*=\s*(.+)$/) {
162        pb_log(3,"DEBUG: 1:$1 2:$2 3:$3\n");
163        $h{$1}{$2}=$3;
164    }
165}
166close(CONF);
167
168for my $param (@param) {
169    push @ptr,$h{$param};
170}
171return(@ptr);
172}
173
174=item B<pb_conf_get_if>
175
176This function returns a table, corresponding to a set of values queried in the conf files or undef if it doen't exist. It takes a table of keys as an input parameter.
177
178The format of the configurations file is as follows:
179
180key tag = value1,value2,...
181
182It will gather the values from all the configurations files passed to pb_conf_add, and return the values for the keys, taking in account the order of conf files, to manage overloading.
183
184  $ cat $HOME/.pbrc
185  pbver pb = 1
186  pblist pb = 4
187  $ cat $HOME/.pbrc2
188  pbver pb = 3
189  pblist default = 5
190
191calling it like this:
192
193  pb_conf_add("$HOME/.pbrc","$HOME/.pbrc2");
194  my ($k1, $k2) = pb_conf_get_if("pbver","pblist");
195
196will allow to get the mapping:
197
198  $k1->{'pb'} contains 3
199  $k2->{'pb'} contains 4
200
201Valid chars for keys and tags are letters, numbers, '-' and '_'.
202
203=cut
204
205sub pb_conf_get_if {
206
207my @param = @_;
208
209my $ptr = undef;
210
211# the most important conf file is first, so read them in reverse order
212foreach my $f (reverse sort { $pbconffiles{$a} <=> $pbconffiles{$b} } keys %pbconffiles) {
213    pb_log(2,"DEBUG: pb_conf_get_if in file $f\n");
214    $ptr = pb_conf_get_fromfile_if("$f",$ptr,@param);
215}
216
217return(@$ptr);
218}
219
220=item B<pb_conf_fromfile_if>
221
222This function returns a pointer on a table, corresponding to a merge of values queried in the conf file and the pointer on another table passed as parameter. It takes a table of keys as last input parameter.
223
224  my ($k1) = pb_conf_fromfile_if("$HOME/.pbrc",undef,"pbver","pblist");
225  my ($k2) = pb_conf_fromfile_if("$HOME/.pbrc3",$k1,"pbver","pblist");
226
227It is used internally by pb_conf_get_if and is not exported yet.
228
229=cut
230
231
232sub pb_conf_get_fromfile_if {
233
234my $conffile = shift;
235my $ptr2 = shift || undef;
236my @param = @_;
237
238# Everything is returned via ptr1
239my @ptr1 = ();
240my @ptr2 = ();
241
242# @ptr1 contains the values overloading what @ptr2 may contain.
243@ptr1 = pb_conf_read_if("$conffile", @param) if (defined $conffile);
244@ptr2 = @$ptr2 if (defined $ptr2);
245
246my $p1;
247my $p2;
248
249pb_log(2,"DEBUG: pb_conf_get_from_file $conffile: ".Dumper(@ptr1)."\n");
250pb_log(2,"DEBUG: pb_conf_get_from_file input: ".Dumper(@ptr2)."\n");
251pb_log(2,"DEBUG: pb_conf_get_from_file param: ".Dumper(@param)."\n");
252
253foreach my $i (0..$#param) {
254    $p1 = $ptr1[$i];
255    # Optimisation doesn't seem useful
256    # if ((defined $p1) && (defined $cachedval{$p1})) {
257    # $ptr1[$i] = $cachedval{$p1};
258    # next;
259    # }
260    $p2 = $ptr2[$i];
261    # Always try to take the param from ptr1
262    # in order to mask what could be defined already in ptr2
263    if (not defined $p2) {
264        # exit if no p1 either
265        next if ((not defined $p1) || (not defined $ENV{'PBPROJ'}));
266        # No ref in p2 so use p1
267        $p1->{$ENV{'PBPROJ'}} = $p1->{'default'} if ((not defined $p1->{$ENV{'PBPROJ'}}) && (defined $p1->{'default'}));
268    } else {
269        # Ref found in p2
270        if (not defined $p1) {
271            # No ref in p1 so use p2's value
272            $p2->{$ENV{'PBPROJ'}} = $p2->{'default'} if ((not defined $p2->{$ENV{'PBPROJ'}}) && (defined $p2->{'default'}));
273            $p1 = $p2;
274        } else {
275            # Both are defined - handling the overloading
276            if (not defined $p1->{'default'}) {
277                if (defined $p2->{'default'}) {
278                    $p1->{'default'} = $p2->{'default'};
279                }
280            }
281
282            if (not defined $p1->{$ENV{'PBPROJ'}}) {
283                if (defined $p2->{$ENV{'PBPROJ'}}) {
284                    $p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}} if (defined $p2->{$ENV{'PBPROJ'}});
285                } else {
286                    $p1->{$ENV{'PBPROJ'}} = $p1->{'default'} if (defined $p1->{'default'});
287                }
288            }
289            # Now copy back into p1 all p2 content which doesn't exist in p1
290            # p1 content always has priority over p2
291            foreach my $k (keys %$p2) {
292                $p1->{$k} = $p2->{$k} if (not defined $p1->{$k});
293            }
294        }
295    }
296    $ptr1[$i] = $p1;
297    # Cache values to avoid redoing all that analyze when asked again on a known value
298    # $cachedval{$p1} = $p1;
299}
300pb_log(2,"DEBUG: pb_conf_get output: ".Dumper(@ptr1)."\n");
301return(\@ptr1);
302}
303
304=item B<pb_conf_get>
305
306This function is the same B<pb_conf_get_if>, except that it tests each returned value as they need to exist in that case.
307
308=cut
309
310sub pb_conf_get {
311
312my @param = @_;
313my @return = pb_conf_get_if(@param);
314my $proj = undef;
315
316if (not defined $ENV{'PBPROJ'}) {
317    $proj = "unknown";
318} else {
319    $proj = $ENV{'PBPROJ'};
320}
321
322die "No params found for $proj" if (not @return);
323
324foreach my $i (0..$#param) {
325    die "No $param[$i] defined for $proj" if (not defined $return[$i]);
326}
327return(@return);
328}
329
330=back
331
332=head1 WEB SITES
333
334The 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/>.
335
336=head1 USER MAILING LIST
337
338None exists for the moment.
339
340=head1 AUTHORS
341
342The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
343
344=head1 COPYRIGHT
345
346Project-Builder.org is distributed under the GPL v2.0 license
347described in the file C<COPYING> included with the distribution.
348
349=cut
350
351
3521;
Note: See TracBrowser for help on using the repository browser.