aboutsummaryrefslogtreecommitdiffstats
path: root/Distribconf/Build.pm
diff options
context:
space:
mode:
authorOlivier Thauvin <nanardon@mandriva.org>2005-02-22 20:12:31 +0000
committerOlivier Thauvin <nanardon@mandriva.org>2005-02-22 20:12:31 +0000
commit28905c5cfb4de3adb854b5a614e7db9be1dcb2da (patch)
tree941b6085c28ffc1596ee524cdd1fa9d7e703cbe9 /Distribconf/Build.pm
parentd8e108f070b7147afd1eafa961590be09c28429d (diff)
downloadrpmtools-28905c5cfb4de3adb854b5a614e7db9be1dcb2da.tar
rpmtools-28905c5cfb4de3adb854b5a614e7db9be1dcb2da.tar.gz
rpmtools-28905c5cfb4de3adb854b5a614e7db9be1dcb2da.tar.bz2
rpmtools-28905c5cfb4de3adb854b5a614e7db9be1dcb2da.tar.xz
rpmtools-28905c5cfb4de3adb854b5a614e7db9be1dcb2da.zip
- split Distribconf with Build
- add write_VERSION
Diffstat (limited to 'Distribconf/Build.pm')
-rw-r--r--Distribconf/Build.pm265
1 files changed, 265 insertions, 0 deletions
diff --git a/Distribconf/Build.pm b/Distribconf/Build.pm
new file mode 100644
index 0000000..fac096d
--- /dev/null
+++ b/Distribconf/Build.pm
@@ -0,0 +1,265 @@
+##- Nanar <nanardon@mandrake.org>
+##-
+##- 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 - 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<Distribconf>
+
+=head1 AUTHOR
+
+The code has been written by Olivier Thauvin <nanardon@mandrake.org>.
+
+The media.cfg has been improved by Warly <warly@mandrakesoft.com>.
+
+Special thanks to Rafael Garcia-Suarez <rgarciasuarez@mandrakesoft.com> for
+suggesting to use Config::IniFiles.
+
+Thanks to Sylvie Terjan <erinmargault@mandrake.org> for the spell checking.
+
+=head1 ChangeLog
+
+ $Log$
+ 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