source: ProjectBuilder/devel/pb-modules/lib/ProjectBuilder/Distribution.pm@ 1553

Last change on this file since 1553 was 1553, checked in by Bruno Cornec, 12 years ago
  • pb: log when we start and finish the build, that's an important state. Add missing setting of all_ok to false that kept us from properly stopping on errors. Fix typos in comments (coma => comma). Greatly simplify pb_get_distros function by using split and join. Also remove whitespace since multi-line conf file support will cause that to be added. (Eric Anderson)
  • Filter.pm: use new pb_pbos_to_keylist function to generate the list of basenames we want, and use a loop rather than lots of separate statements. Simplifies and makes more powerful this function. Also now guaranteed to maintain consistency with key lookups in the hash maps. (Eric Anderson)
  • rename pb_pbos_to_keylist to pb_distro_to_keylist and make it public (Bruno Cornec)
File size: 21.3 KB
Line 
1#!/usr/bin/perl -w
2#
3# Creates common environment for distributions
4#
5# Copyright B. Cornec 2007-2012
6# Eric Anderson's changes are (c) Copyright 2012 Hewlett Packard
7# Provided under the GPL v2
8#
9# $Id$
10#
11
12package ProjectBuilder::Distribution;
13
14use strict;
15use Data::Dumper;
16use Carp 'confess';
17use ProjectBuilder::Version;
18use ProjectBuilder::Base;
19use ProjectBuilder::Conf;
20use File::Basename;
21use File::Copy;
22# requires perl 5.004 minimum in VM/VE
23use File::Compare;
24
25# Global vars
26# Inherit from the "Exporter" module which handles exporting functions.
27
28use vars qw($VERSION $REVISION @ISA @EXPORT);
29use Exporter;
30
31# Export, by default, all the functions into the namespace of
32# any code which uses this module.
33
34our @ISA = qw(Exporter);
35our @EXPORT = qw(pb_distro_conffile pb_distro_get pb_distro_getlsb pb_distro_installdeps pb_distro_getdeps pb_distro_only_deps_needed pb_distro_setuprepo pb_distro_setuposrepo pb_distro_get_param pb_distro_get_context pb_distro_to_keylist);
36($VERSION,$REVISION) = pb_version_init();
37
38=pod
39
40=head1 NAME
41
42ProjectBuilder::Distribution, part of the project-builder.org - module dealing with distribution detection
43
44=head1 DESCRIPTION
45
46This modules provides functions to allow detection of Linux distributions, and giving back some attributes concerning them.
47
48=head1 SYNOPSIS
49
50 use ProjectBuilder::Distribution;
51
52 #
53 # Return information on the running distro
54 #
55 my $pbos = pb_distro_get_context();
56 print "distro tuple: ".Dumper($pbos->name, $pbos->ver, $pbos->fam, $pbos->type, $pbos->pbsuf, $pbos->pbupd, $pbos->pbins, $pbos->arch)."\n";
57 #
58 # Return information on the requested distro
59 #
60 my $pbos = pb_distro_get_context("ubuntu-7.10-x86_64");
61 print "distro tuple: ".Dumper($pbos->name, $pbos->ver, $pbos->fam, $pbos->type, $pbos->pbsuf, $pbos->pbupd, $pbos->pbins, $pbos->arch)."\n";
62 #
63 # Return information on the running distro
64 #
65 my ($ddir,$dver) = pb_distro_get();
66
67=head1 USAGE
68
69=over 4
70
71=item B<pb_distro_conffile>
72
73This function returns the mandatory configuration file used for distribution/OS detection
74
75=cut
76
77sub pb_distro_conffile {
78
79return("CCCC/pb.conf");
80}
81
82
83=item B<pb_distro_init>
84
85This function returns a hash of parameters indicating the distribution name, version, family, type of build system, suffix of packages, update command line, installation command line and architecture of the underlying Linux distribution. The value of the fields may be "unknown" in case the function was unable to recognize on which distribution it is running.
86
87As an example, Ubuntu and Debian are in the same "du" family. As well as RedHat, RHEL, CentOS, fedora are on the same "rh" family.
88Mandriva, Open SuSE and Fedora have all the same "rpm" type of build system. Ubuntu and Debian have the same "deb" type of build system.
89And "fc" is the extension generated for all Fedora packages (Version will be added by pb).
90All this information is stored in an external configuration file typically at /etc/pb/pb.conf
91
92When passing the distribution name and version as parameters, the B<pb_distro_init> function returns the parameter of that distribution instead of the underlying one.
93
94Cf: http://linuxmafia.com/faq/Admin/release-files.html
95Ideas taken from http://search.cpan.org/~kerberus/Linux-Distribution-0.14/lib/Linux/Distribution.pm
96
97=cut
98
99
100sub pb_distro_init {
101
102my $pbos = {
103 'name' => undef,
104 'version' => undef,
105 'arch' => undef,
106 'family' => "unknown",
107 'suffix' => "unknown",
108 'update' => "unknown",
109 'install' => "unknown",
110 'type' => "unknown",
111 'os' => "unknown",
112 'nover' => "false",
113 'rmdot' => "false",
114 'useminor' => "false",
115 };
116$pbos->{'name'} = shift;
117$pbos->{'version'} = shift;
118$pbos->{'arch'} = shift;
119
120# Adds conf file for distribution description
121# the location of the conf file is finalyzed at install time
122# depending whether we deal with package install or tar file install
123pb_conf_add(pb_distro_conffile());
124
125# If we don't know which distribution we're on, then guess it
126($pbos->{'name'},$pbos->{'version'}) = pb_distro_get() if ((not defined $pbos->{'name'}) || (not defined $pbos->{'version'}));
127
128# For some rare cases, typically nover ones
129$pbos->{'name'} = "unknown" if (not defined $pbos->{'name'});
130$pbos->{'version'} = "unknown" if (not defined $pbos->{'version'});
131
132# Initialize arch
133$pbos->{'arch'} = pb_get_arch() if (not defined $pbos->{'arch'});
134
135# Dig into the tuple to find the best answer
136# Do NOT factorize here, as it won't work as of now for hash creation
137# Do NOT change order without caution
138$pbos->{'useminor'} = pb_distro_get_param($pbos,pb_conf_get("osuseminorrel"));
139$pbos->{'family'} = pb_distro_get_param($pbos,pb_conf_get("osfamily"));
140$pbos->{'type'} = pb_distro_get_param($pbos,pb_conf_get("ostype"));
141($pbos->{'os'},$pbos->{'install'},$pbos->{'suffix'},$pbos->{'nover'},$pbos->{'rmdot'},$pbos->{'update'}) = pb_distro_get_param($pbos,pb_conf_get("os","osins","ossuffix","osnover","osremovedotinver","osupd"));
142#($pbos->{'family'},$pbos->{'type'},$pbos->{'os'},$pbos->{'install'},$pbos->{'suffix'},$pbos->{'nover'},$pbos->{'rmdot'},$pbos->{'update'}) = pb_distro_get_param($pbos,pb_conf_get("osfamily","ostype","os","osins","ossuffix","osnover","osremovedotinver","osupd"));
143
144# Some OS have no interesting version
145$pbos->{'version'} = "nover" if ((defined $pbos->{'nover'}) && ($pbos->{'nover'} eq "true"));
146
147# For some OS remove the . in version name for extension
148my $dver2 = $pbos->{'version'};
149$dver2 =~ s/\.//g if ((defined $pbos->{'rmdot'}) && ($pbos->{'rmdot'} eq "true"));
150
151if ((not defined $pbos->{'suffix'}) || ($pbos->{'suffix'} eq "")) {
152 # By default suffix is a concatenation of name and version
153 $pbos->{'suffix'} = ".$pbos->{'name'}$dver2"
154} else {
155 # concat just the version to what has been found
156 $pbos->{'suffix'} = ".$pbos->{'suffix'}$dver2";
157}
158
159# if ($arch eq "x86_64") {
160# $opt="--exclude=*.i?86";
161# }
162pb_log(2,"DEBUG: pb_distro_init: ".Dumper($pbos)."\n");
163
164return($pbos);
165}
166
167=item B<pb_distro_get>
168
169This function returns a list of 2 parameters indicating the distribution name and version of the underlying Linux distribution. The value of those 2 fields may be "unknown" in case the function was unable to recognize on which distribution it is running.
170
171On my home machine it would currently report ("mandriva","2010.2").
172
173=cut
174
175sub pb_distro_get {
176
177# 1: List of files that unambiguously indicates what distro we have
178# 2: List of files that ambiguously indicates what distro we have
179# 3: Should have the same keys as the previous one. If ambiguity, which other distributions should be checked
180# 4: Matching Rg. Expr to detect distribution and version
181my ($single_rel_files, $ambiguous_rel_files,$distro_similar,$distro_match) = pb_conf_get("osrelfile","osrelambfile","osambiguous","osrelexpr");
182
183my $release;
184my $distro;
185
186# Begin to test presence of non-ambiguous files
187# that way we reduce the choice
188my ($d,$r);
189while (($d,$r) = each %$single_rel_files) {
190 if (defined $ambiguous_rel_files->{$d}) {
191 print STDERR "The key $d is considered as both unambiguous and ambigous.\n";
192 print STDERR "Please fix your configuration file.\n"
193 }
194 if (-f "$r" && ! -l "$r") {
195 my $tmp=pb_get_content("$r");
196 # Found the only possibility.
197 # Try to get version and return
198 if (defined ($distro_match->{$d})) {
199 ($release) = $tmp =~ m/$distro_match->{$d}/m;
200 } else {
201 print STDERR "Unable to find $d version in $r (non-ambiguous)\n";
202 print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
203 $release = "unknown";
204 }
205 return($d,$release);
206 }
207}
208
209# Now look at ambiguous files
210# Ubuntu before 10.04 includes a /etc/debian_version file that creates an ambiguity with debian
211# So we need to look at distros in reverse alphabetic order to treat ubuntu always first via lsb
212foreach $d (reverse keys %$ambiguous_rel_files) {
213 $r = $ambiguous_rel_files->{$d};
214 if (-f "$r" && !-l "$r") {
215 # Found one possibility.
216 # Get all distros concerned by that file
217 my $tmp=pb_get_content("$r");
218 my $found = 0;
219 my $ptr = $distro_similar->{$d};
220 pb_log(2,"amb: ".Dumper($ptr)."\n");
221 $release = "unknown";
222 foreach my $dd (split(/,/,$ptr)) {
223 pb_log(2,"check $dd\n");
224 # Try to check pattern
225 if (defined $distro_match->{$dd}) {
226 pb_log(2,"cmp: $distro_match->{$dd} - vs - $tmp\n");
227 ($release) = $tmp =~ m/$distro_match->{$dd}/m;
228 if ((defined $release) && ($release ne "unknown")) {
229 $distro = $dd;
230 $found = 1;
231 last;
232 }
233 }
234 }
235 if ($found == 0) {
236 print STDERR "Unable to find $d version in $r (ambiguous)\n";
237 print STDERR "Please report to the maintainer bruno_at_project-builder.org\n";
238 $release = "unknown";
239 } else {
240 return($distro,$release);
241 }
242 }
243}
244return("unknown","unknown");
245}
246
247=item B<pb_distro_getlsb>
248
249This function returns the 5 lsb values LSB version, distribution ID, Description, release and codename.
250As entry it takes an optional parameter to specify whether the output is short or not.
251
252=cut
253
254sub pb_distro_getlsb {
255
256my $s = shift;
257pb_log(3,"Entering pb_distro_getlsb\n");
258
259my ($ambiguous_rel_files) = pb_conf_get("osrelambfile");
260my $lsbf = $ambiguous_rel_files->{"lsb"};
261
262# LSB has not been configured.
263if (not defined $lsbf) {
264 print STDERR "no lsb entry defined for osrelambfile\n";
265 die "You modified upstream delivery and lost !\n";
266}
267
268if (-r $lsbf) {
269 my $rep = pb_get_content($lsbf);
270 # Create elementary fields
271 my ($c, $r, $d, $i, $l) = ("", "", "", "", "");
272 for my $f (split(/\n/,$rep)) {
273 pb_log(3,"Reading file part ***$f***\n");
274 $c = $f if ($f =~ /^DISTRIB_CODENAME/);
275 $c =~ s/DISTRIB_CODENAME=/Codename:\t/;
276 $r = $f if ($f =~ /^DISTRIB_RELEASE/);
277 $r =~ s/DISTRIB_RELEASE=/Release:\t/;
278 $d = $f if ($f =~ /^DISTRIB_DESCRIPTION/);
279 $d =~ s/DISTRIB_DESCRIPTION=/Description:\t/;
280 $d =~ s/"//g;
281 $i = $f if ($f =~ /^DISTRIB_ID/);
282 $i =~ s/DISTRIB_ID=/Distributor ID:\t/;
283 $l = $f if ($f =~ /^LSB_VERSION/);
284 $l =~ s/LSB_VERSION=/LSB Version:\t/;
285 }
286 my $regexp = "^[A-z ]*:[\t ]*";
287 $c =~ s/$regexp// if (defined $s);
288 $r =~ s/$regexp// if (defined $s);
289 $d =~ s/$regexp// if (defined $s);
290 $i =~ s/$regexp// if (defined $s);
291 $l =~ s/$regexp// if (defined $s);
292 return($l, $i, $d, $r, $c);
293} else {
294 print STDERR "Unable to read $lsbf file\n";
295 die "Please report to the maintainer bruno_at_project-builder.org\n";
296}
297}
298
299# Internal function
300
301sub pb_apply_conf_proxy ($) {
302my ($pbos) = @_;
303
304my $ftp_proxy = pb_distro_get_param($pbos,pb_conf_get_if("ftp_proxy"));
305my $http_proxy = pb_distro_get_param($pbos,pb_conf_get_if("http_proxy"));
306
307# We do not overwrite shell settings
308$ENV{ftp_proxy} ||= $ftp_proxy;
309$ENV{http_proxy} ||= $http_proxy;
310}
311
312=item B<pb_distro_installdeps>
313
314This function install the dependencies required to build the package on a distro.
315Dependencies can be passed as a parameter in which case they are not computed
316
317=cut
318
319sub pb_distro_installdeps {
320
321# SPEC file
322my $f = shift || undef;
323my $pbos = shift;
324my $deps = shift || undef;
325
326# Protection
327die "Missing install command for $pbos->{name}-$pbos->{version}-$pbos->{arch}" unless (defined $pbos->{install} && $pbos->{install} =~ /\w/);
328pb_apply_conf_proxy($pbos);
329
330# Get dependencies in the build file if not forced
331$deps = pb_distro_getdeps($f,$pbos) if (not defined $deps);
332pb_log(1, "ftp_proxy=$ENV{ftp_proxy} http_proxy=$ENV{http_proxy}\n");
333pb_log(2,"deps: $deps\n");
334return if ((not defined $deps) || ($deps =~ /^\s*$/));
335
336# This may not be // proof. We should test for availability of repo and sleep if not
337my $cmd = "$pbos->{'install'} $deps";
338my $ret = pb_system($cmd, "Installing dependencies ($cmd)",undef,1);
339# Try to accomodate deficient proxies
340if ($ret != 0) {
341 pb_system($cmd, "Re-trying installing dependencies ($cmd)");
342}
343# Check that all deps have been installed correctly
344$deps = pb_distro_getdeps($f, $pbos);
345die "Some dependencies did not install ($deps)" if ((defined $deps) && ($deps =~ /\S/));
346}
347
348=item B<pb_distro_getdeps>
349
350This function computes the dependencies indicated in the build file and return them as a string of packages to install
351
352=cut
353
354sub pb_distro_getdeps {
355
356my $f = shift || undef;
357my $pbos = shift;
358
359my $regexp = "";
360my $deps = "";
361my $sep = $/;
362
363# Protection
364return("") if (not defined $pbos->{'type'});
365return("") if (not defined $f);
366
367pb_log(3,"entering pb_distro_getdeps: $pbos->{'type'} - $f\n");
368if ($pbos->{'type'} eq "rpm") {
369 # In RPM this could include files, but we do not handle them atm.
370 $regexp = '^BuildRequires:(.*)$';
371} elsif ($pbos->{'type'} eq "deb") {
372 $regexp = '^Build-Depends:(.*)$';
373} elsif ($pbos->{'type'} eq "ebuild") {
374 $sep = '"'.$/;
375 $regexp = '^DEPEND="(.*)"\n'
376} else {
377 # No idea
378 return("");
379}
380pb_log(2,"regexp: $regexp\n");
381
382# Preserve separator before using the one we need
383my $oldsep = $/;
384$/ = $sep;
385open(DESC,"$f") || die "Unable to open $f";
386while (<DESC>) {
387 pb_log(4,"read: $_\n");
388 next if (! /$regexp/);
389 chomp();
390
391 my $nextline;
392 # Support multi-lines deps for .deb
393 if ($pbos->{type} eq 'deb') {
394 while ($nextline = <DESC>) {
395 last unless $nextline =~ /^\s+(.+)$/o;
396 $_ .= $1;
397 }
398 }
399
400 # What we found with the regexp is the list of deps.
401 pb_log(2,"found deps: $_\n");
402 s/$regexp/$1/i;
403 # Remove conditions in the middle and at the end for deb
404 s/\(\s*[><=]+.*\)[^,]*,/,/g;
405 s/\(\s*[><=]+.*$//g;
406 # Same for rpm
407 s/[><=]+[^,]*,/,/g;
408 s/[><=]+.*$//g;
409 # Improve string format (remove , and spaces at start, end and in double
410 s/,/ /g;
411 s/^\s*//;
412 s/\s*$//;
413 s/\s+/ /g;
414 $deps .= " ".$_;
415
416 # Support multi-lines deps for .deb (fwup)
417 if (defined $nextline) {
418 $_ = $nextline;
419 redo;
420 }
421}
422close(DESC);
423$/ = $oldsep;
424pb_log(2,"now deps: $deps\n");
425my $deps2 = pb_distro_only_deps_needed($pbos,$deps);
426return($deps2);
427}
428
429
430=item B<pb_distro_only_deps_needed>
431
432This function returns only the dependencies not yet installed
433
434=cut
435
436sub pb_distro_only_deps_needed {
437
438my $pbos = shift;
439my $deps = shift || undef;
440
441return("") if ((not defined $deps) || ($deps =~ /^\s*$/));
442my $deps2 = "";
443# Avoid to install what is already there
444delete $ENV{COLUMNS};
445foreach my $p (split(/\s+/,$deps)) {
446 next if $p =~ /^\s*$/o;
447 if ($pbos->{'type'} eq "rpm") {
448 my $res = pb_system("rpm -q --whatprovides --quiet $p","","quiet",1);
449 next if ($res eq 0);
450 pb_log(1, "INFO: missing dependency $p\n");
451 } elsif ($pbos->{'type'} eq "deb") {
452 my $res = pb_system("dpkg -L $p","","quiet",1);
453 next if ($res eq 0);
454 open(CMD,"dpkg -l $p |") or die "Unable to run dpkg -l $p: $!";
455 my $ok = 0;
456 while (<CMD>) {
457 $ok = 1 if /^ii\s+$p/;
458 }
459 close(CMD);
460 next if $ok;
461 pb_log(1, "INFO: missing dependency $p\n");
462 } elsif ($pbos->{'type'} eq "ebuild") {
463 } else {
464 # Not reached
465 }
466 pb_log(2,"found deps2: $p\n");
467 $deps2 .= " $p";
468}
469
470$deps2 =~ s/^\s*//;
471pb_log(2,"now deps2: $deps2\n");
472return($deps2);
473}
474
475=item B<pb_distro_setuposrepo>
476
477This function sets up potential additional repository for the setup phase
478
479=cut
480
481sub pb_distro_setuposrepo {
482
483my $pbos = shift;
484
485pb_distro_setuprepo_gen($pbos,pb_distro_conffile(),"osrepo");
486}
487
488=item B<pb_distro_setuprepo>
489
490This function sets up potential additional repository to the build environment
491
492=cut
493
494sub pb_distro_setuprepo {
495
496my $pbos = shift;
497
498pb_distro_setuprepo_gen($pbos,"$ENV{'PBDESTDIR'}/pbrc","addrepo");
499}
500
501# Internal
502sub pb_distro_compare_repo {
503
504my $src = shift;
505my $dest = shift;
506
507if (not -f $dest) {
508 pb_log(1, "INFO: Creating new file $dest\n");
509} elsif (-f $dest && -s $dest == 0) {
510 pb_log(1, "INFO: Overwriting empty file $dest\n");
511} elsif (-f $dest && compare("$src", $dest) == 0) {
512 pb_log(1, "INFO: Overwriting identical file $dest\n");
513} else {
514 pb_log(0, "ERROR: destination file $dest exists and is different than source $src\n");
515 pb_system("cat $dest","INFO: Dest...\n");
516 pb_system("cat $src","INFO: New...\n");
517 pb_log("INFO: Returning...\n");
518 return(0);
519}
520# TRUE
521return(1);
522}
523
524=item B<pb_distro_setuprepo_gen>
525
526This function sets up in a generic way potential additional repository
527
528=cut
529
530sub pb_distro_setuprepo_gen {
531
532my $pbos = shift;
533my $pbconf = shift || undef;
534my $pbkey = shift || undef;
535
536return if (not defined $pbconf);
537return if (not defined $pbkey);
538my ($addrepo) = pb_conf_read($pbconf,$pbkey);
539return if (not defined $addrepo);
540
541my $param = pb_distro_get_param($pbos,$addrepo);
542return if ($param eq "");
543
544pb_apply_conf_proxy($pbos);
545
546# Loop on the list of additional repo
547foreach my $i (split(/,/,$param)) {
548
549 my ($scheme, $account, $host, $port, $path) = pb_get_uri($i);
550 my $bn = basename($i);
551
552 # The repo file can be local or remote. download or copy at the right place
553 if (($scheme eq "ftp") || ($scheme eq "http")) {
554 pb_system("wget -O $ENV{'PBTMP'}/$bn $i","Downloading additional repository file $i");
555 } else {
556 copy($i,$ENV{'PBTMP'}/$bn);
557 }
558
559 # The repo file can be a real file or a package
560 if ($pbos->{'type'} eq "rpm") {
561 if ($bn =~ /\.rpm$/) {
562 my $pn = $bn;
563 $pn =~ s/\.rpm//;
564 if (pb_system("rpm -q --quiet $pn","","quiet",1) != 0) {
565 pb_system("sudo rpm -Uvh $ENV{'PBTMP'}/$bn","Adding package to setup repository");
566 }
567 } elsif ($bn =~ /\.repo$/) {
568 my $dirdest = "";
569 my $reponame = "";
570 # TODO: could go in pb.conf in fact
571 if ($pbos->{install} =~ /\byum\b/) {
572 $reponame="yum";
573 $dirdest = "/etc/yum.repos.d";
574 } elsif ($pbos->{install} =~ /\bzypper\b/) {
575 $reponame="zypper";
576 $dirdest = "/etc/zypp/repos.d";
577 } else {
578 die "Unknown location for repository file for '$pbos->{install}' command";
579 }
580 my $dest = "$dirdest/$bn";
581 return if (pb_distro_compare_repo($ENV{'PBTMP'}/$bn,$dest));
582 die "Missing directory $dirdest ($reponame)" unless (-d $dirdest);
583 pb_system("sudo mv $ENV{'PBTMP'}/$bn $dirdest/$bn","Adding $reponame repository") if (not -f "$dirdest/$bn");
584 } elsif ($bn =~ /\.addmedia/) {
585 # URPMI repo
586 # We should test that it's not already a urpmi repo
587 pb_system("chmod 755 $ENV{'PBTMP'}/$bn ; sudo $ENV{'PBTMP'}/$bn 2>&1 > /dev/null","Adding urpmi repository");
588 } else {
589 pb_log(0,"ERROR: Unable to deal with repository file $i on rpm distro ! Please report to dev team\n");
590 }
591 } elsif ($pbos->{'type'} eq "deb") {
592 if ($bn =~ /\.sources.list$/) {
593 my $dest = "/etc/apt/sources.list.d/$bn";
594 return if (pb_distro_compare_repo($ENV{'PBTMP'}/$bn,$dest));
595 pb_system("sudo mv $ENV{'PBTMP'}/$bn /etc/apt/sources.list.d","Adding apt repository");
596 pb_system("sudo apt-get update","Updating apt repository");
597 } else {
598 pb_log(0,"ERROR: Unable to deal with repository file $i on deb distro ! Please report to dev team\n");
599 }
600 } else {
601 pb_log(0,"ERROR: Unable to deal with repository file $i on that distro ! Please report to dev team\n");
602 }
603}
604return;
605}
606
607=item B<pb_distro_to_keylist>
608
609Given a pbos object (first param) and the generic key (second param), get the list of possible keys for looking up variable for
610filter names. The list will be sorted most-specific to least specific.
611
612=cut
613
614sub pb_distro_to_keylist ($$) {
615
616my ($pbos, $generic) = @_;
617
618foreach my $key (qw/name version arch family type os/) {
619 confess "missing pbos key $key" unless (defined $pbos->{$key});
620}
621
622my @keylist = ("$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}", "$pbos->{'name'}-$pbos->{'version'}");
623
624# Loop to include also previous minor versions
625# if configured so
626if ((defined $pbos->{'useminor'}) && ($pbos->{'useminor'} eq "true") && ($pbos->{'version'} =~ /^(\d+)\.(\d+)$/o)) {
627 my ($major, $minor) = ($1, $2);
628 while ($minor > 0) {
629 $minor--;
630 push (@keylist, "$pbos->{'name'}-${major}.$minor");
631 }
632 push (@keylist, "$pbos->{'name'}-$major");
633}
634
635push (@keylist, $pbos->{'name'}, $pbos->{'family'}, $pbos->{'type'}, $pbos->{'os'}, $generic);
636return @keylist;
637}
638
639=item B<pb_distro_get_param>
640
641This function gets the parameter in the conf file from the most precise tuple up to default
642
643=cut
644
645sub pb_distro_get_param {
646
647my @param = ();
648my $pbos = shift;
649
650my @keylist = pb_distro_to_keylist($pbos,"default");
651pb_log(2,"DEBUG: pb_distro_get_param on $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} for ".Dumper(@_)."\n");
652foreach my $opt (@_) {
653 my $param = "";
654 foreach my $key (@keylist) {
655 if (defined $opt->{$key}) {
656 $param = $opt->{$key};
657 last;
658 }
659 }
660 # Allow replacement of variables inside the parameter such as name, version, arch for rpmbootstrap
661 # but not shell variable which are backslashed
662 if ($param =~ /[^\\]\$/) {
663 pb_log(3,"Expanding variable on $param\n");
664 eval { $param =~ s/(\$\w+->{\'\w+\'})/$1/eeg };
665 }
666 push @param,$param;
667}
668
669pb_log(2,"DEBUG: pb_distro_get_param on $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} returns ==".Dumper(@param)."==\n");
670
671# Return one param if user only asked for one lookup, an array if not.
672my $nb = @param;
673if ($nb eq 1) {
674 return($param[0]);
675} else {
676 return(@param);
677}
678}
679
680=item B<pb_distro_get_context>
681
682This function gets the OS context passed as parameter and return the corresponding distribution hash
683If passed undef or "" then auto-detects
684
685=cut
686
687
688sub pb_distro_get_context {
689
690my $os = shift;
691my $pbos;
692
693if ((defined $os) && ($os ne "")) {
694 my ($name,$ver,$darch) = split(/-/,$os);
695 pb_log(0,"Bad format for $os") if ((not defined $name) || (not defined $ver) || (not defined $darch)) ;
696 chomp($darch);
697 $pbos = pb_distro_init($name,$ver,$darch);
698} else {
699 $pbos = pb_distro_init();
700}
701return($pbos);
702}
703
704=back
705
706=head1 WEB SITES
707
708The 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/>.
709
710=head1 USER MAILING LIST
711
712None exists for the moment.
713
714=head1 AUTHORS
715
716The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.
717
718=head1 COPYRIGHT
719
720Project-Builder.org is distributed under the GPL v2.0 license
721described in the file C<COPYING> included with the distribution.
722
723=cut
724
725
7261;
Note: See TracBrowser for help on using the repository browser.