- split Distribconf with Build

- add write_VERSION

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