Ignore:
Timestamp:
Feb 7, 2011, 2:24:17 PM (13 years ago)
Author:
Bruno Cornec
Message:

r4161@eelzbach2: bruno | 2011-02-06 21:07:30 +0100

  • Introduction of a new hash $pbos to manage all os related info through a single data structure. All functions reviewed accordingly. Externally transparent, hopefully, but much cleaner code as a consequence. VM/VE/RM remains to be tested.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • devel/pb-modules/lib/ProjectBuilder/Distribution.pm

    r1167 r1177  
    2626 
    2727our @ISA = qw(Exporter);
    28 our @EXPORT = qw(pb_distro_conffile pb_distro_init 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);
     28our @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);
    2929($VERSION,$REVISION) = pb_version_init();
    3030
    … …  
    4646  # Return information on the running distro
    4747  #
    48   my ($ddir, $dver, $dfam, $dtype, $pbsuf, $dos, $pbupd, $pbins, $arch) = pb_distro_init();
    49   print "distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $pbins, $arch)."\n";
     48  my $pbos = pb_distro_get_context();
     49  print "distro tuple: ".Dumper($pbos->name, $pbos->ver, $pbos->fam, $pbos->type, $pbos->pbsuf, $pbos->pbupd, $pbos->pbins, $pbos->arch)."\n";
    5050  #
    5151  # Return information on the requested distro
    5252  #
    53   my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $arch) = pb_distro_init("ubuntu","7.10","x86_64");
    54   print "distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $pbins, $arch)."\n";
     53  my $pbos = pb_distro_get_context("ubuntu-7.10-x86_64");
     54  print "distro tuple: ".Dumper($pbos->name, $pbos->ver, $pbos->fam, $pbos->type, $pbos->pbsuf, $pbos->pbupd, $pbos->pbins, $pbos->arch)."\n";
    5555  #
    5656  # Return information on the running distro
    5757  #
    5858  my ($ddir,$dver) = pb_distro_get();
    59   my ($ddir, $dver, $dfam, $dtype, $dos, $pbsuf, $pbupd, $pbins, $arch) = pb_distro_init($ddir,$dver);
    60   print "distro tuple: ".Dumper($ddir, $dver, $dfam, $dtype, $pbsuf, $pbupd, $pbins, $arch)."\n";
    6159
    6260=head1 USAGE
    … …  
    7876=item B<pb_distro_init>
    7977
    80 This function returns a list of 8 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 8 fields may be "unknown" in case the function was unable to recognize on which distribution it is running.
     78This 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.
    8179
    8280As an example, Ubuntu and Debian are in the same "du" family. As well as RedHat, RHEL, CentOS, fedora are on the same "rh" family.
    83 Mandriva, Open SuSE and Fedora have all the same "rpm" type of build system. Ubuntu ad Debian have the same "deb" type of build system.
     81Mandriva, Open SuSE and Fedora have all the same "rpm" type of build system. Ubuntu and Debian have the same "deb" type of build system.
    8482And "fc" is the extension generated for all Fedora packages (Version will be added by pb).
    85 All these information are stored in an external configuration file typically at /etc/pb/pb.conf
     83All this information is stored in an external configuration file typically at /etc/pb/pb.conf
    8684
    8785When 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.
    … …  
    9593sub pb_distro_init {
    9694
    97 my $ddir = shift || undef;
    98 my $dver = shift || undef;
    99 my $dfam = "unknown";
    100 my $dtype = "unknown";
    101 my $dos = "unknown";
    102 my $dsuf = "unknown";
    103 my $dupd = "unknown";
    104 my $dins = "unknown";
    105 my $darch = shift || undef;
    106 my $dnover = "false";
    107 my $drmdot = "false";
     95my $pbos = {
     96    'name' => undef,
     97    'version' => undef,
     98    'arch' => undef,
     99    'family' => "unknown",
     100    'suffix' => "unknown",
     101    'update' => "unknown",
     102    'install' => "unknown",
     103    'type' => "unknown",
     104    'os' => "unknown",
     105    'nover' => "false",
     106    'rmdot' => "false",
     107    };
     108$pbos->{'name'} = shift;
     109$pbos->{'version'} = shift;
     110$pbos->{'arch'} = shift;
    108111
    109112# Adds conf file for distribution description
    … …  
    113116
    114117# If we don't know which distribution we're on, then guess it
    115 ($ddir,$dver) = pb_distro_get() if ((not defined $ddir) || (not defined $dver));
     118($pbos->{'name'},$pbos->{'version'}) = pb_distro_get() if ((not defined $pbos->{'name'}) || (not defined $pbos->{'version'}));
    116119
    117120# For some rare cases, typically nover ones
    118 $ddir = "unknown" if (not defined $ddir);
    119 $dver = "unknown" if (not defined $dver);
     121$pbos->{'name'} = "unknown" if (not defined $pbos->{'name'});
     122$pbos->{'version'} = "unknown" if (not defined $pbos->{'version'});
    120123
    121124# Initialize arch
    122 $darch=pb_get_arch() if (not defined $darch);
    123 
    124 my ($osfamily,$ostype,$osupd,$osins,$ossuffix,$osnover,$osremovedotinver,$os) = pb_conf_get("osfamily","ostype","osupd","osins","ossuffix","osnover","osremovedotinver","os");
     125$pbos->{'arch'} = pb_get_arch() if (not defined $pbos->{'arch'});
    125126
    126127# Dig into the tuple to find the best answer
    127 $dfam = pb_distro_get_param($ddir,$dver,$darch,$osfamily);
    128 $dtype = pb_distro_get_param($ddir,$dver,$darch,$ostype,$dfam);
    129 $dos = pb_distro_get_param($ddir,$dver,$darch,$os,$dfam,$dtype);
    130 $dupd = pb_distro_get_param($ddir,$dver,$darch,$osupd,$dfam,$dtype,$dos);
    131 $dins = pb_distro_get_param($ddir,$dver,$darch,$osins,$dfam,$dtype,$dos);
    132 $dsuf = pb_distro_get_param($ddir,$dver,$darch,$ossuffix,$dfam,$dtype,$dos);
    133 $dnover = pb_distro_get_param($ddir,$dver,$darch,$osnover,$dfam,$dtype,$dos);
    134 $drmdot = pb_distro_get_param($ddir,$dver,$darch,$osremovedotinver,$dfam,$dtype,$dos);
     128# Do NOT factorize here, as it won't work as of now for hash creation
     129$pbos->{'family'} = pb_distro_get_param($pbos,pb_conf_get("osfamily"));
     130$pbos->{'type'} = pb_distro_get_param($pbos,pb_conf_get("ostype"));
     131($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"));
     132#($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"));
    135133
    136134# Some OS have no interesting version
    137 $dver = "nover" if ($dnover eq "true");
     135$pbos->{'version'} = "nover" if ((defined $pbos->{'nover'}) && ($pbos->{'nover'} eq "true"));
    138136
    139137# For some OS remove the . in version name for extension
    140 my $dver2 = $dver;
    141 $dver2 =~ s/\.//g if ($drmdot eq "true");
    142 
    143 if ((not defined $dsuf) || ($dsuf eq "")) {
    144     # By default suffix is a concatenation of .ddir and dver
    145     $dsuf = ".$ddir$dver2"
     138my $dver2 = $pbos->{'version'};
     139$dver2 =~ s/\.//g if ((defined $pbos->{'rmdot'}) && ($pbos->{'rmdot'} eq "true"));
     140
     141if ((not defined $pbos->{'suffix'}) || ($pbos->{'suffix'} eq "")) {
     142    # By default suffix is a concatenation of name and version
     143    $pbos->{'suffix'} = ".$pbos->{'name'}$dver2"
    146144} else {
    147145    # concat just the version to what has been found
    148     $dsuf = ".$dsuf$dver2";
     146    $pbos->{'suffix'} = ".$pbos->{'suffix'}$dver2";
    149147}
    150148
    … …  
    152150#   $opt="--exclude=*.i?86";
    153151#   }
    154 pb_log(2,"DEBUG: pb_distro_init: $ddir, $dver, $dfam, $dtype, $dsuf, $dupd, $dins, $darch\n");
    155 
    156 return($ddir, $dver, $dfam, $dtype, $dos, $dsuf, $dupd, $dins, $darch);
     152pb_log(2,"DEBUG: pb_distro_init: ".Dumper($pbos)."\n");
     153
     154return($pbos);
    157155}
    158156
    … …  
    276274        $l =~ s/LSB_VERSION=/LSB Version:\t/;
    277275    }
    278     $c =~ s/^[A-z ]*:[\t ]*// if (defined $s);
    279     $r =~ s/^[A-z ]*:[\t ]*// if (defined $s);
    280     $d =~ s/^[A-z ]*:[\t ]*// if (defined $s);
    281     $i =~ s/^[A-z ]*:[\t ]*// if (defined $s);
    282     $l =~ s/^[A-z ]*:[\t ]*// if (defined $s);
     276    my $regexp = "^[A-z ]*:[\t ]*";
     277    $c =~ s/$regexp// if (defined $s);
     278    $r =~ s/$regexp// if (defined $s);
     279    $d =~ s/$regexp// if (defined $s);
     280    $i =~ s/$regexp// if (defined $s);
     281    $l =~ s/$regexp// if (defined $s);
    283282    return($l, $i, $d, $r, $c);
    284283} else {
    … …  
    290289=item B<pb_distro_installdeps>
    291290
    292 This function install the dependencies required to build the package on an RPM based distro
    293 dependencies can be passed as a parameter in which case they are not computed
     291This function install the dependencies required to build the package on a distro.
     292Dependencies can be passed as a parameter in which case they are not computed
    294293
    295294=cut
    … …  
    299298# SPEC file
    300299my $f = shift || undef;
    301 my $dtype = shift || undef;
    302 my $dupd = shift || undef;
     300my $pbos = shift;
    303301my $deps = shift || undef;
    304302
    305303# Protection
    306 return if (not defined $dupd);
    307 
    308 # Get dependecies in the build file if not forced
    309 $deps = pb_distro_getdeps($f, $dtype) if (not defined $deps);
     304return if (not defined $pbos->{'update'});
     305
     306# Get dependencies in the build file if not forced
     307$deps = pb_distro_getdeps($f, $pbos) if (not defined $deps);
    310308pb_log(2,"deps: $deps\n");
    311309return if ((not defined $deps) || ($deps =~ /^\s*$/));
    312310if ($deps !~ /^[    ]*$/) {
    313311    # This may not be // proof. We should test for availability of repo and sleep if not
    314     pb_system("$dupd $deps","Installing dependencies ($deps)");
     312    pb_system("$pbos->{'update'} $deps","Installing dependencies ($deps)");
    315313    }
    316314}
    … …  
    325323
    326324my $f = shift || undef;
    327 my $dtype = shift || undef;
     325my $pbos = shift;
    328326
    329327my $regexp = "";
    … …  
    332330
    333331# Protection
    334 return("") if (not defined $dtype);
     332return("") if (not defined $pbos->{'type'});
    335333return("") if (not defined $f);
    336334
    337 pb_log(3,"entering pb_distro_getdeps: $dtype - $f\n");
    338 if ($dtype eq  "rpm") {
     335pb_log(3,"entering pb_distro_getdeps: $pbos->{'type'} - $f\n");
     336if ($pbos->{'type'} eq  "rpm") {
    339337    # In RPM this could include files, but we do not handle them atm.
    340338    $regexp = '^BuildRequires:(.*)$';
    341 } elsif ($dtype eq "deb") {
     339} elsif ($pbos->{'type'} eq "deb") {
    342340    $regexp = '^Build-Depends:(.*)$';
    343 } elsif ($dtype eq "ebuild") {
     341} elsif ($pbos->{'type'} eq "ebuild") {
    344342    $sep = '"'.$/;
    345343    $regexp = '^DEPEND="(.*)"\n'
    … …  
    377375$/ = $oldsep;
    378376pb_log(2,"now deps: $deps\n");
    379 my $deps2 = pb_distro_only_deps_needed($dtype,$deps);
     377my $deps2 = pb_distro_only_deps_needed($pbos,$deps);
    380378return($deps2);
    381379}
    … …  
    390388sub pb_distro_only_deps_needed {
    391389
    392 my $dtype = shift || undef;
     390my $pbos = shift;
    393391my $deps = shift || undef;
    394392
    … …  
    397395# Avoid to install what is already there
    398396foreach my $p (split(/ /,$deps)) {
    399     if ($dtype eq  "rpm") {
     397    if ($pbos->{'type'} eq  "rpm") {
    400398        my $res = pb_system("rpm -q --whatprovides --quiet $p","","quiet");
    401399        next if ($res eq 0);
    402     } elsif ($dtype eq "deb") {
     400    } elsif ($pbos->{'type'} eq "deb") {
    403401        my $res = pb_system("dpkg -L $p","","quiet");
    404402        next if ($res eq 0);
    405     } elsif ($dtype eq "ebuild") {
     403    } elsif ($pbos->{'type'} eq "ebuild") {
    406404    } else {
    407405        # Not reached
    … …  
    424422sub pb_distro_setuposrepo {
    425423
    426 my $ddir = shift || undef;
    427 my $dver = shift;
    428 my $darch = shift;
    429 my $dtype = shift || undef;
    430 my $dfam = shift || undef;
    431 my $dos = shift || undef;
    432 
    433 pb_distro_setuprepo_gen($ddir,$dver,$darch,$dtype,$dfam,$dos,pb_distro_conffile(),"osrepo");
     424my $pbos = shift;
     425
     426pb_distro_setuprepo_gen($pbos,pb_distro_conffile(),"osrepo");
    434427}
    435428
    … …  
    442435sub pb_distro_setuprepo {
    443436
    444 my $ddir = shift || undef;
    445 my $dver = shift;
    446 my $darch = shift;
    447 my $dtype = shift || undef;
    448 my $dfam = shift || undef;
    449 my $dos = shift || undef;
    450 
    451 pb_distro_setuprepo_gen($ddir,$dver,$darch,$dtype,$dfam,$dos,"$ENV{'PBDESTDIR'}/pbrc","addrepo");
     437my $pbos = shift;
     438
     439pb_distro_setuprepo_gen($pbos,"$ENV{'PBDESTDIR'}/pbrc","addrepo");
    452440}
    453441
    … …  
    460448sub pb_distro_setuprepo_gen {
    461449
    462 my $ddir = shift || undef;
    463 my $dver = shift;
    464 my $darch = shift;
    465 my $dtype = shift || undef;
    466 my $dfam = shift || undef;
    467 my $dos = shift || undef;
     450my $pbos = shift;
    468451my $pbconf = shift || undef;
    469452my $pbkey = shift || undef;
    … …  
    474457return if (not defined $addrepo);
    475458
    476 my $param = pb_distro_get_param($ddir,$dver,$darch,$addrepo,$dfam,$dtype,$dos);
     459my $param = pb_distro_get_param($pbos,$addrepo);
    477460return if ($param eq "");
    478461
    … …  
    491474
    492475    # The repo file can be a real file or a package
    493     if ($dtype eq "rpm") {
     476    if ($pbos->{'type'} eq "rpm") {
    494477        if ($bn =~ /\.rpm$/) {
    495478            my $pn = $bn;
    … …  
    508491            pb_log(0,"Unable to deal with repository file $i on rpm distro ! Please report to dev team\n");
    509492        }
    510     } elsif ($dtype eq "deb") {
     493    } elsif ($pbos->{'type'} eq "deb") {
    511494        if (($bn =~ /\.sources.list$/) && (not -f "/etc/apt/sources.list.d/$bn")) {
    512495            pb_system("sudo mv $ENV{'PBTMP'}/$bn /etc/apt/sources.list.d","Adding apt repository");
    … …  
    530513sub pb_distro_get_param {
    531514
    532 my $param = "";
    533 my $ddir = shift;
    534 my $dver = shift;
    535 my $darch = shift;
    536 my $opt = shift;
    537 my $dfam = shift || "unknown";
    538 my $dtype = shift || "unknown";
    539 my $dos = shift || "unknown";
    540 
    541 pb_log(2,"DEBUG: pb_distro_get_param on $ddir-$dver-$darch for ".Dumper($opt)."\n");
    542 if (defined $opt->{"$ddir-$dver-$darch"}) {
    543     $param = $opt->{"$ddir-$dver-$darch"};
    544 } elsif (defined $opt->{"$ddir-$dver"}) {
    545     $param = $opt->{"$ddir-$dver"};
    546 } elsif (defined $opt->{"$ddir"}) {
    547     $param = $opt->{"$ddir"};
    548 } elsif (defined $opt->{$dfam}) {
    549     $param = $opt->{$dfam};
    550 } elsif (defined $opt->{$dtype}) {
    551     $param = $opt->{$dtype};
    552 } elsif (defined $opt->{$dos}) {
    553     $param = $opt->{$dos};
    554 } elsif (defined $opt->{"default"}) {
    555     $param = $opt->{"default"};
     515my @param;
     516my $param;
     517my $pbos = shift;
     518
     519pb_log(2,"DEBUG: pb_distro_get_param on $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} for ".Dumper(@_)."\n");
     520foreach my $opt (@_) {
     521    if (defined $opt->{"$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}"}) {
     522        $param = $opt->{"$pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'}"};
     523    } elsif (defined $opt->{"$pbos->{'name'}-$pbos->{'version'}"}) {
     524        $param = $opt->{"$pbos->{'name'}-$pbos->{'version'}"};
     525    } elsif (defined $opt->{"$pbos->{'name'}"}) {
     526        $param = $opt->{"$pbos->{'name'}"};
     527    } elsif (defined $opt->{$pbos->{'family'}}) {
     528        $param = $opt->{$pbos->{'family'}};
     529    } elsif (defined $opt->{$pbos->{'type'}}) {
     530        $param = $opt->{$pbos->{'type'}};
     531    } elsif (defined $opt->{$pbos->{'os'}}) {
     532        $param = $opt->{$pbos->{'os'}};
     533    } elsif (defined $opt->{"default"}) {
     534        $param = $opt->{"default"};
     535    } else {
     536        $param = "";
     537    }
     538
     539    # Allow replacement of variables inside the parameter such as name, version, arch for rpmbootstrap
     540    # but not shell variable which are backslashed
     541    if ($param =~ /[^\\]\$/) {
     542        pb_log(3,"Expanding variable on $param\n");
     543        eval { $param =~ s/(\$\w+)/$1/eeg };
     544    }
     545    push @param,$param;
     546}
     547
     548pb_log(2,"DEBUG: pb_distro_get_param on $pbos->{'name'}-$pbos->{'version'}-$pbos->{'arch'} returns ==".Dumper(@param)."==\n");
     549
     550# Return one param in scalar context, an array if not.
     551my $nb = @param;
     552if ($nb eq 1) {
     553    return($param);
    556554} else {
    557     $param = "";
    558 }
    559 
    560 # Allow replacement of variables inside the parameter such as ddir, dver, darch for rpmbootstrap
    561 # but not shell variable which are backslashed
    562 if ($param =~ /[^\\]\$/) {
    563     pb_log(3,"Expanding variable on $param\n");
    564     eval { $param =~ s/(\$\w+)/$1/eeg };
    565 }
    566 
    567 pb_log(2,"DEBUG: pb_distro_get_param on $ddir-$dver-$darch returns ==$param==\n");
    568 return($param);
    569 
    570 }
    571 
     555    return(@param);
     556}
     557}
     558
     559=item B<pb_distro_get_context>
     560
     561This function gets the OS context passed as parameter and return the corresponding distribution hash
     562
     563=cut
     564
     565
     566sub pb_distro_get_context {
     567
     568my $os = shift;
     569my $pbos;
     570
     571if (defined $os) {
     572    my ($name,$ver,$darch) = split(/-/,$os);
     573    pb_log(0,"Bad format for $os") if ((not defined $name) || (not defined $ver) || (not defined $darch)) ;
     574    chomp($darch);
     575    $pbos = pb_distro_init($name,$ver,$darch);
     576} else {
     577    $pbos = pb_distro_init();
     578}
     579return($pbos);
     580}
    572581
    573582=back
Note: See TracChangeset for help on using the changeset viewer.