diff options
| -rw-r--r-- | Distribconf.pm | 136 | ||||
| -rw-r--r-- | Distribconf/Build.pm | 265 |
2 files changed, 290 insertions, 111 deletions
diff --git a/Distribconf.pm b/Distribconf.pm index 7ddca15..92cc274 100644 --- a/Distribconf.pm +++ b/Distribconf.pm @@ -266,7 +266,9 @@ sub parse_hdlists { $distrib->{cfg} = new Config::IniFiles( -default => 'media_info', -allowcontinue => 1); my $i = 0; foreach (<$h_hdlists>) { + s/#.*//; chomp; + length or next; my ($options, %media); ($options, @media{qw/hdlist path name size/}) = $_ =~ m/^\s*(?:(.*):)?(\S+)\s+(\S+)\s+([^(]*)(?:\s+\((\w+)\))?$/; @@ -278,41 +280,26 @@ sub parse_hdlists { } } close($h_hdlists); + return 1; } -=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. +=head2 parse_version($version) =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; - } - - if (ref($hdlists) ne 'GLOB') { - close($h_hdlists); - } +sub parse_version { + my ($distrib, $fversion) = @_; + $fversion ||= $distrib->getfullpath(undef, 'VERSION'); + open(my $h_ver, "<", $fversion) or return 0; + my $l = <$h_ver>; + chomp($l); + my ($version, $branch, $product, $arch) = $l =~ /^mandrake ?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); + close($h_ver); return 1; } @@ -334,22 +321,6 @@ sub parse_mediacfg { 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 listmedia Return an array of existing medium in the configuration @@ -387,33 +358,15 @@ sub getvalue { $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$/ and do { $default = ''; last; }; + /^branch$/ and do { $default = ''; last; }; /^mediadir$|^infodir$/ and do { $default = $distrib->{$var}; last; }; } return $distrib->{cfg}->val($media, $var, $default); } -=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); - } -} - =head2 getpath($media, $var) Give relative path from the root of the distrib. @@ -428,7 +381,7 @@ sub getpath { my ($distrib, $media, $var) = @_; my $val = $distrib->getvalue($media, $var); - $var =~ /^root$/ and return $val; + $var =~ /^root$|^VERSION$/ and return $val; return ($val =~ m!/! ? "" : ($var eq 'path' ? $distrib->{mediadir} : $distrib->{infodir} ) . "/") . $val; } @@ -448,49 +401,6 @@ sub getfullpath { 1; -=head2 check - -=cut - -sub check { - my ($distrib, $out) = @_; - $out ||= \*STDOUT; - - $distrib->listmedia or print $out "W: No media found in this config\n"; - - # Checking no overlap - foreach my $var (qw/name hdlist synthesis path/) { - my %e; - foreach ($distrib->listmedia) { - my $v = $var eq 'name' ? $distrib->getvalue($_, $var) : $distrib->getpath($_, $var); - push @{$e{$v}}, $_; - } - - foreach my $key (keys %e) { - if (@{$e{$key}} > 1) { - printf $out "E: medium %s have same %s (%s)\n", - join (", ", @{$e{$key}}), - $var, - $key; - } - } - } - - foreach my $media ($distrib->listmedia) { - -d $distrib->getfullpath($media, 'path') or - printf $out "E: dir %s don't exist for media '%s'\n", - $distrib->getpath($media, 'path'), - $media; - - foreach (qw/hdlist synthesis pubkey/) { - -f $distrib->getfullpath($media, $_) or - printf $out "E: $_ %s don't exist for media '%s'\n", - $distrib->getpath($media, $_), - $media; - } - } -} - __END__ =head1 AUTHOR @@ -507,6 +417,10 @@ Thanks to Sylvie Terjan <erinmargault@mandrake.org> for the spell checking. =head1 ChangeLog $Log$ + Revision 1.8 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 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 |