##- 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: Build.pm,v 1.1 2005/02/22 20:12:31 othauvin Exp $ package Distribconf::Build; =head1 NAME Distribconf::Build - Extend Distribconf module to allow building the conf =head1 METHODS =cut use strict; use warnings; use Distribconf; use vars qw(@ISA); @ISA = qw(Distribconf); =head2 new(root_of_distrib) Return a new Distribconf::Build object =cut sub new { my ($class, @options) = @_; my $self = $class->SUPER::new(@options); bless($self, $class); } =head2 write_hdlists($hdlists) Write the hdlists file into the media information directory, or into the $hdlists given as argument. $hdlists can be a file path, or a glob reference (\*STDOUT for example). Return 1 on success, 0 on error. =cut =head2 setvalue($media, $var, $val) Set or add $var parameter from $media to $val. If $media does not exists, it is implicitly created. If $var is not defined, a new media is create without parameters defined. =cut sub setvalue { my ($distrib, $media, $var, $val) = @_; if ($var) { $var =~ /^mediadir$|^infodir$/ and do { $distrib->{$var} = $val; return; }; $distrib->{cfg}->newval($media, $var, $val) or die "Can't set value"; } else { $distrib->{cfg}->AddSection($media); } } 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; } if (ref($hdlists) ne 'GLOB') { close($h_hdlists); } return 1; } =head2 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). Return 1 on success, 0 on error. =cut sub write_mediacfg { my ($distrib, $hdlistscfg) = @_; $hdlistscfg ||= "$distrib->{root}/$distrib->{infodir}/media.cfg"; $distrib->{cfg}->WriteConfig($hdlistscfg); } =head2 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 "Mandrakelinux %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; } =head2 check($out) Perform a check on the distribution and print to $out (STDOUT by default) errors found =cut sub check { my ($distrib, $out) = @_; $out ||= \*STDOUT; my $error = 0; my $report_err = sub { my ($l, $f, @msg) = @_; $l eq 'E' and $error++; printf $out "$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', "medium %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 don't exist for media '%s'", $distrib->getpath($media, 'path'), $media ); foreach (qw/hdlist synthesis pubkey/) { -f $distrib->getfullpath($media, $_) or $report_err->('E', "$_ %s don't exist for media '%s'", $distrib->getpath($media, $_), $media ); } } return $error; } 1; __END__ =head1 SEE ALSO L =head1 AUTHOR The code has been written by Olivier Thauvin . The media.cfg has been improved by Warly . Special thanks to Rafael Garcia-Suarez for suggesting to use Config::IniFiles. Thanks to Sylvie Terjan for the spell checking. =head1 ChangeLog $Log: Build.pm,v $ Revision 1.1 2005/02/22 20:12:31 othauvin - split Distribconf with Build - add write_VERSION Revision 1.7 2005/02/22 12:52:51 othauvin - don't add a 'm' to size in hdlists Revision 1.6 2005/02/21 21:40:10 othauvin - add getfullpath - s![ /]*!_! in default path - add check() Revision 1.5 2005/02/21 15:34:56 othauvin Distribconf Revision 1.4 2005/02/21 13:14:19 othauvin - add doc for pubkey Revision 1.3 2005/02/21 13:11:01 othauvin - lowercase media name in file name - manage pubkey Revision 1.2 2005/02/21 12:47:34 othauvin - avoid error message about non existing media.cfg Revision 1.1 2005/02/20 21:15:50 othauvin - initials release for managing mandrakelinux distro tree =cut