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

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