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

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