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

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