From c6805f46921be979f492c935505a3e7658f689a7 Mon Sep 17 00:00:00 2001 From: Olivier Thauvin Date: Sun, 9 Oct 2005 16:18:35 +0000 Subject: - import --- lib/MDV/Distribconf.pm | 407 +++++++++++++++++++++++++++++++++++++++++++ lib/MDV/Distribconf/Build.pm | 217 +++++++++++++++++++++++ 2 files changed, 624 insertions(+) create mode 100644 lib/MDV/Distribconf.pm create mode 100644 lib/MDV/Distribconf/Build.pm diff --git a/lib/MDV/Distribconf.pm b/lib/MDV/Distribconf.pm new file mode 100644 index 0000000..c6873a8 --- /dev/null +++ b/lib/MDV/Distribconf.pm @@ -0,0 +1,407 @@ +package MDV::Distribconf; + +(our $VERSION) = q$Id$ =~ /(\d+\.\d+)/; + +=head1 NAME + +Distribconf - perl module to get config from a Mandriva Linux distribution tree + +=head1 SYNOPSIS + + use Distribconf; + + my $d = Distribconf->new("/path/to/the/distribution/root"); + $d->load() + or die "This doesn't seem to be a distribution tree\n"; + + print $d->getpath(undef, "root") ."\n"; + foreach ($d->listmedia) { + printf "%s -> %s\n", $d->getpath($_, "hdlist"), $d->getpath($_, path); + } + +=head1 DESCRIPTION + +Distribconf is a module to get/write the configuration of a Mandriva Linux +distribution tree. This configuration is stored in a file called F, +aimed at replacing the old-style F file. + +The format of the F file is limited and doesn't allow to add new +values without breaking compatibility, while F is designed for +extensibility. To keep compatibility with old tools, this module is able +to generate an F file based on F. + +This module is able to manage both configuration of old-style trees +(F for OS versions 10.0 and older) and of new-style ones +(F for 10.1 and newer). + +=head1 media.cfg + +The F is structured like a classical F<.ini> file. All +parameters are optional; this means that a readable empty file is ok, if +this is what you want :) + +F contains sections, each section corresponding to a media, +except the C<[media_info]> section wich is used to store global info. The +section name is the (relative) path where the rpms are located. It is +sufficient to uniquely identify a media. + +Some values have specific signification: + +=over 4 + +=item media specific values: + +=over 4 + +=item B + +The path or basename of the hdlist. By default, this is +C, with slashes and spaces being replaced by '_'. + +=item B + +The path or basename of the synthesis. By default, this is the hdlist +name prefixed by C. + +=item B + +The path or basename of the gpg public key file. By default, this is +the media name prefixed by C. + +=item B + +A human-readable name for the media. By default this is the media path +(that is, the section name), where slashes have been replaced by +underscores. + +=back + +=item global specific values: + +=over 4 + +=item B + +OS version. + +=item B + +OS branch (cooker, etc.) + +=item B + +Media target architecture. + +=item B + +The root path of the distribution tree. This value is not set in +F, can't be owerwritten, and is only used internally. + +=item B + +The default path relative to the 'root' path where media are +located. Distribconf is supposed to configure this automatically +to C or to C, depending on the OS version. + +=item B + +The default path relative to the 'root' path where distrib metadata +are located. Distribconf is supposed to configure this automatically +to C or to C, depending on the OS +version. + +=back + +=back + +For the paths of the hdlist and synthesis files, if only a basename is +provided, the path is assumed to be relative to the mediadir or infodir. +(hdlist and synthesis are created in both directories.) If it's a complete +path, it's assumed to be relative to the 'root'. For example, + + hdlist.cz -> //hdlist.cz + ./hdlist.cz -> /./hdlist.cz + +Here's a complete example of a F file: + + # Comment + [media_info] + # some tools can use those values + version=2006.0 + branch=cooker + + [main] + hdlist=hdlist_main.cz + name=Main + + [../SRPMS/main] + hdlist=hdlist_main.src.cz + name=Main Sources + noauto=1 + + [contrib] + hdlist=hdlist_contrib.cz + name=Contrib + + [../SRPMS/contrib] + hdlist=hdlist_contrib.src.cz + name=Contrib Sources + noauto=1 + +=head1 METHODS + +=cut + +use strict; +use warnings; +use Config::IniFiles; + +=head2 Distribconf->new($root) + +Returns a new Distribconf object, C<$root> being the top level +directory of the tree. + +=cut + +sub new { + my ($class, $path) = @_; + bless { + root => $path, + infodir => '', + mediadir => '', + cfg => new Config::IniFiles(-default => 'media_info', -allowcontinue => 1), + }, $class; +} + +=head2 $distrib->load() + +Finds and loads the configuration of the distrib: locate the path where +information is found; if available loads F, if available loads +F. + +Returns 1 on success, 0 error (that is, if no directory containing media +information is found, or if no F, neither F files are +found). + +See also L, L and L. + +=cut + +sub load { + my ($distrib) = @_; + $distrib->loadtree() or return 0; + $distrib->parse_mediacfg() || $distrib->parse_hdlists() or return 0; + return 1; +} + +=head2 $distrib->loadtree() + +Tries to find a valid media information directory, and set infodir and +mediadir. Returns 1 on success, 0 if no media information directory was +found. + +=cut + +sub loadtree { + my ($distrib) = @_; + + if (-d "$distrib->{root}/media/media_info") { + $distrib->{infodir} = "media/media_info"; + $distrib->{mediadir} = "media"; + } elsif (-d "$distrib->{root}/Mandrake/base") { + $distrib->{infodir} = "Mandrake/base"; + $distrib->{mediadir} = "Mandrake"; + } else { + return 0; + } + return 1; +} + +=head2 $distrib->parse_hdlists($hdlists) + +Reads the F file whose path is given by the parameter $hdlist, +or, if no parameter is specified, the F file found in the media +information directory of the distribution. Returns 1 on success, 0 if no +F can be found or parsed. + +=cut + +sub parse_hdlists { + my ($distrib, $hdlists) = @_; + $hdlists ||= "$distrib->{root}/$distrib->{infodir}/hdlists"; + + open my $h_hdlists, "<", $hdlists + or return 0; + $distrib->{cfg} = new Config::IniFiles( -default => 'media_info', -allowcontinue => 1); + my $i = 0; + foreach (<$h_hdlists>) { + s/#.*//; s/^\s*//; + chomp; + length or next; + my ($options, %media); + ($options, @media{qw/hdlist path name size/}) = /^\s*(?:(.*):)?(\S+)\s+(\S+)\s+([^(]*)(?:\s+\((\w+)\))?$/; + if ($options) { + $media{$_} = 1 foreach split /:/, $options; + } + $media{name} =~ s/\s*$//; + $media{path} =~ s!^$distrib->{mediadir}/+!!; + foreach (qw/hdlist name size/, $options ? split(/:/, $options) : ()) { + $distrib->{cfg}->newval($media{path}, $_, $media{$_}) + or die "Can't set value [$_]\n"; + } + } + close($h_hdlists); + + return 1; +} + +=head2 $distrib->parse_version($fversion) + +Reads the F file whose path is given by the parameter $fversion, +or, if no parameter is specified, the F file found in the media +information directory of the distribution. Returns 1 on success, 0 if no +F can be found or parsed. + +=cut + +sub parse_version { + my ($distrib, $fversion) = @_; + $fversion ||= $distrib->getfullpath(undef, 'VERSION'); + open my $h_ver, "<", $fversion + or return 0; + my $l = <$h_ver>; + close $h_ver; + chomp $l; + # XXX heuristics ahead. This breaks regularly. + my ($version, $branch, $product, $arch) = $l =~ /^(?:mandrake|mandriva) ?linux\s+(\w+)\s+([^- ]*)-([^- ]*)-([^- ]*)/i; + $distrib->{cfg}->newval('media_info', 'version', $version); + $distrib->{cfg}->newval('media_info', 'branch', $branch); + $distrib->{cfg}->newval('media_info', 'product', $product); + $distrib->{cfg}->newval('media_info', 'arch', $arch); + return 1; +} + +=head2 $distrib->parse_mediacfg($mediacfg) + +Reads the F file whose path is given by the parameter +$mediacfg, or, if no parameter is specified, the F file found +in the media information directory of the distribution. Returns 1 on +success, 0 if no F can be found or parsed. + +=cut + +sub parse_mediacfg { + my ($distrib, $mediacfg) = @_; + $mediacfg ||= "$distrib->{root}/$distrib->{infodir}/media.cfg"; + (-f $mediacfg && -r _) && + ($distrib->{cfg} = new Config::IniFiles( -file => $mediacfg, -default => 'media_info', -allowcontinue => 1)) + or return 0; + return 1; +} + +=head2 $distrib->listmedia() + +Returns an array of existing media in the configuration + +=cut + +sub listmedia { + my ($distrib) = @_; + return grep { $_ ne 'media_info' } $distrib->{cfg}->Sections; +} + +=head2 $distrib->getvalue($media, $var) + +Returns the $var value for $media, or C if the value is not set. + +If $var is "name", "hdlist" or "synthesis", and if the value is not explicitly +defined, the return value is expanded from $media. + +If $media is "media_info" or C, you'll get the global value. + +This function doesn't take care about path, see L. + +=cut + +sub getvalue { + my ($distrib, $media, $var) = @_; + $media ||= 'media_info'; + + my $default = ""; + for ($var) { + /^synthesis$/ and $default = 'synthesis.' . lc($distrib->getvalue($media, 'hdlist')); + /^hdlist$/ and $default = 'hdlist_' . lc($distrib->getvalue($media, 'name')) . '.cz'; + /^pubkey$/ and $default = 'pubkey_' . lc($distrib->getvalue($media, 'name')); + /^name$/ and $default = $media; + $default =~ s![/ ]+!_!g; + /^path$/ and return $media; + /^root$/ and return $distrib->{root}; + /^VERSION$/ and do { $default = 'VERSION'; last }; + /^product$/ and do { $default = 'Download'; last }; + /^(?:tag|branch)$/ and do { $default = ''; last }; + /^(?:media|info)dir$/ and do { $default = $distrib->{$var}; last }; + } + return $distrib->{cfg}->val($media, $var, $default); +} + +=head2 $distrib->getpath($media, $var) + +Gives relative path of $var from the root of the distrib. This function is +useful to know where files are actually located. It takes care of location +of media, location of index files, and paths set in the configuration. + +=cut + +sub getpath { + my ($distrib, $media, $var) = @_; + + my $val = $distrib->getvalue($media, $var); + $var =~ /^(?:root|VERSION)$/ and return $val; + return ($val =~ m!/! ? "" : ($var eq 'path' ? $distrib->{mediadir} : $distrib->{infodir} ) . "/") . $val; +} + +=head2 $distrib->getfullpath($media, $var) + +Does the same thing than getpath(), but the return value will be +prefixed by the 'root' path. This is a shortcut for: + + $distrib->getpath(undef, 'root') . '/' . $distrib->getpath($media, $var). + +=cut + +sub getfullpath { + my $distrib = shift; + return $distrib->getpath(undef, 'root') . '/' . $distrib->getpath(@_); +} + +1; + +__END__ + +=head1 SEE ALSO + +gendistrib(1) + +=head1 AUTHOR + +The code has been written by Olivier Thauvin and is +currently maintained by Rafael Garcia-Suarez . +Thanks to Sylvie Terjan for the spell checking. + +(c) 2005 Olivier Thauvin + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +=cut diff --git a/lib/MDV/Distribconf/Build.pm b/lib/MDV/Distribconf/Build.pm new file mode 100644 index 0000000..1d5cb4c --- /dev/null +++ b/lib/MDV/Distribconf/Build.pm @@ -0,0 +1,217 @@ +##- Nanar +##- +##- This program is free software; you can redistribute it and/or modify +##- it under the terms of the GNU General Public License as published by +##- the Free Software Foundation; either version 2, or (at your option) +##- any later version. +##- +##- This program is distributed in the hope that it will be useful, +##- but WITHOUT ANY WARRANTY; without even the implied warranty of +##- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +##- GNU General Public License for more details. +##- +##- You should have received a copy of the GNU General Public License +##- along with this program; if not, write to the Free Software +##- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# +# $Id$ + +package Distribconf::Build; + +=head1 NAME + +Distribconf::Build - Extension to Distribconf to build configuration + +=head1 METHODS + +=over 4 + +=cut + +use strict; +use warnings; +use Distribconf; + +our @ISA = qw(Distribconf); +our $VERSION = $Distribconf::VERSION; + +=item Distribconf::Build->new($root_of_distrib) + +Returns a new Distribconf::Build object. + +=cut + +sub new { + my $class = shift; + my $self = $class->SUPER::new(@_); + bless $self, $class; +} + +=item $distrib->setvalue($media, $var, $val) + +Sets or adds $var parameter from $media to $val. If $media doesn't exist, +it is implicitly created. If $var is C, a new media is created with +no defined parameters. + +=cut + +sub setvalue { + my ($distrib, $media, $var, $val) = @_; + if ($var) { + $var =~ /^(?:media|info)dir\z/ and do { + $distrib->{$var} = $val; + return; + }; + $distrib->{cfg}->newval($media, $var, $val) + or die "Can't set value [$var=$val] for $media\n"; + } else { + $distrib->{cfg}->AddSection($media); + } +} + +=item $distrib->write_hdlists($hdlists) + +Writes the F file to C<$hdlists>, or if no parameter is given, in +the media information directory. C<$hdlists> can be a file path or a file +handle. Returns 1 on success, 0 on error. + +=cut + +sub write_hdlists { + my ($distrib, $hdlists) = @_; + my $h_hdlists; + if (ref $hdlists eq 'GLOB') { + $h_hdlists = $hdlists; + } else { + $hdlists ||= "$distrib->{root}/$distrib->{infodir}/hdlists"; + open $h_hdlists, ">", $hdlists + or return 0; + } + foreach my $media ($distrib->listmedia) { + printf($h_hdlists "%s%s\t%s\t%s\t%s\n", + join('', map { "$_:" } grep { $distrib->getvalue($media, $_) } qw/askmedia suppl noauto/) || "", + $distrib->getvalue($media, 'hdlist'), + $distrib->getpath($media, 'path'), + $distrib->getvalue($media, 'name'), + $distrib->getvalue($media, 'size') ? '('.$distrib->getvalue($media, 'size'). ')' : "", + ) or return 0; + } + return 1; +} + +=item $distrib->write_mediacfg($mediacfg) + +Write the media.cfg file into the media information directory, or into the +$mediacfg given as argument. $mediacfg can be a file path, or a glob reference +(\*STDOUT for example). + +Returns 1 on success, 0 on error. + +=cut + +sub write_mediacfg { + my ($distrib, $hdlistscfg) = @_; + $hdlistscfg ||= "$distrib->{root}/$distrib->{infodir}/media.cfg"; + $distrib->{cfg}->WriteConfig($hdlistscfg); +} + +=item $distrib->write_version($version) + +=cut + +sub write_version { + my ($distrib, $version) = @_; + my $h_version; + if (ref($version) eq 'GLOB') { + $h_version = $version; + } else { + $version ||= $distrib->getfullpath(undef, 'VERSION'); + open($h_version, ">", $version) or return 0; + } + + my @gmt = gmtime(time); + + printf($h_version "Mandriva Linux %s %s-%s-%s%s %s\n", + $distrib->getvalue(undef, 'version') || 'cooker', + $distrib->getvalue(undef, 'branch') || 'cooker', + $distrib->getvalue(undef, 'arch') || 'noarch', + $distrib->getvalue(undef, 'product'), + $distrib->getvalue(undef, 'tag') ? '-' . $distrib->getvalue(undef, 'tag') : '', + sprintf("%04d%02d%02d %02d:%02d", $gmt[5] + 1900, $gmt[4]+1, $gmt[3], $gmt[2], $gmt[1]) + ); + + if (ref($version) ne 'GLOB') { + close($h_version); + } + return 1; +} + + +=item $distrib->check($fhout) + +Performs basic checks on the distribution and prints to $fhout (STDERR by +default) warnings and errors found. Returns the number of errors reported. + +=cut + +sub check { + my ($distrib, $fhout) = @_; + $fhout ||= \*STDERR; + + my $error = 0; + + my $report_err = sub { + my ($l, $f, @msg) = @_; + $l eq 'E' and $error++; + printf $fhout "$l: $f\n", @msg; + }; + + $distrib->listmedia or $report_err->('W', "No media found in this config"); + + # Checking no overlap + foreach my $var (qw/hdlist synthesis path/) { + my %e; + foreach ($distrib->listmedia) { + my $v = $distrib->getpath($_, $var); + push @{$e{$v}}, $_; + } + + foreach my $key (keys %e) { + if (@{$e{$key}} > 1) { + $report_err->('E', "media %s have same %s (%s)", + join (", ", @{$e{$key}}), + $var, + $key + ); + } + } + } + + foreach my $media ($distrib->listmedia) { + -d $distrib->getfullpath($media, 'path') or $report_err->( + 'E', "dir %s does't exist for media '%s'", + $distrib->getpath($media, 'path'), + $media + ); + foreach (qw/hdlist synthesis pubkey/) { + -f $distrib->getfullpath($media, $_) or $report_err->( + 'E', "$_ %s doesn't exist for media '%s'", + $distrib->getpath($media, $_), + $media + ); + } + } + return $error; +} + +1; + +__END__ + +=back + +=head1 SEE ALSO + +L + +=cut -- cgit v1.2.1