package Mkcd::Tools;

our $VERSION = '0.4.3';

use strict;
use File::NCopy qw(copy);       
use Image::Size qw(:all);
use Mkcd::Commandline qw(parseCommandLine usage);
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(printTable getTracks du cpal checkcds checkDiscs cleanrpmsrate imageSize printDiscsFile readBatchFile printBatchFile config);

=head1 NAME

tools - mkcd tools

=head1 SYNOPSYS

    require mkcd::tools;

=head1 DESCRIPTION

C<mkcd::tools> includes mkcd tools.

=head1 SEE ALSO

mkcd

=head1 COPYRIGHT

Copyright (C) 2000,2001 MandrakeSoft <warly@mandrakesoft.com>

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

sub printTable {
    my ($a,$log) = @_;
    my $LOG; if ($log) { my $LOG = $log } else { open $LOG, ">&STDERR"}
    #
    # iterative version of a recursive scanning of a table.
    # ex: @config = [[[1,3],3,[1,3,[1,3]]],3,4,[4,[4,4]]]
    #	
    my @A;
    my @i;
    my @tab;
    my $i = 0;
    while ($a){
	my $u = ref $a;
	if ($u eq 'ARRAY') {
	    while ($i < @$a){
		my $b = $a->[$i];
		my $t = ref $b;
		if ($t eq 'ARRAY'){
		    push @tab, "\t";
		    push @i, $i+1;
		    push @A, $a;
		    $i = 0;
		    $a = $b;
		    next
		} elsif ($t eq 'HASH') { 
		    $i++; print {$LOG} "@tab", join ' ',keys %$b,"\n"
		} else { $i++; print {$LOG} "@tab$b\n" }
	    }
	} else { print {$LOG} "$a\n" }
	pop @tab;
	$i = pop @i;
	$a = pop @A;
    }

}

sub getTracks{
    my ($tracks,$log) = @_;
    my $LOG; if ($log) { my $LOG = $log } else { open $LOG, ">&STDERR"}
    print {$LOG} "getTracks: $tracks\n";
    my @tracks = split ',',$tracks;
    my @t;
    foreach (@tracks){
	/(\d+)/ and push @t, $1;
	/(\d+)-(\d+)/ and push @t, $1..$2	
    }
    my @tracks;
    my %done;
    for(my $i = $#t; $i >= 0; $i-- ){
	push @tracks, $t[$i] if !$done{$t[$i]};
	$done{$t[$i]}=1
    }
    \@tracks;
}

sub du {
    my ($path,$size) = @_;
    my $size;
    if (-d $path){
	opendir O, $path;
	foreach (readdir O){
	    /^\.{1,2}$/ and next;
	    -l "$path/$_" or $size += du("$path/$_")
	}
    } else {
	-l $path or $size = (stat $path)[7] + 2048;
    }
    $size
}

sub cpal{
    my ($source,$dest,$exclude,$verbose,$log) = @_;
    my $LOG; if ($log) { my $LOG = $log } else { open $LOG, ">&STDERR"}
    if ($exclude && "$source/$_" =~ /$exclude/) {return 0}
    if (!-l $source && -d $source){
	mkdir "$dest";
	opendir O, $source; 
	foreach (readdir O){
	    /^\.{1,2}$/ and next;
	    cpal("$source/$_","$dest/$_",$exclude,$verbose)
	}
    }else {
	my $err;
	if (-d $dest){ my ($filename) = $source =~ /([^\/]*)$/; $dest .= "/$filename"}
	$err = link "$source","$dest" ;
	$verbose and print {$LOG} "cpal: link $source -> $dest\n" ; 
	if (!$err) { 
	    print {$LOG} "Linking failed $source -> $dest: $!, trying to copy\n" ; 
	    $err = copy "$source", "$dest"; 
	    if (!$err) { print {$LOG} "Copying failed $source -> $dest: $!,\n"; return 0}
	}
    }
    1
}

sub checkDiscs{
    my ($hdlists,$depslist,$discsFiles,$check,$log) = @_;
    my $LOG; if ($log) { $LOG = $log } else { open $LOG, ">&STDOUT"}
    local *A; open A, $depslist or print {$LOG} "ERROR: unable to open $depslist" and return 0;

    #
    # depslist hdlist consistency -> error   ok (not the same as instal one, but duplicate will break anyway)
    #
    # in hdlist, not in depslist -> error    ok
    # 
    # in hdlist, not in dir -> error         ok 
    #
    # in depslist, not in hdlist -> error    ok
    #
    # in depslist, not in dir -> error       ok
    #
    # in dir, not in hdlist -> warning       ok
    #
    # in dir, not in depslist -> warning     ok
    #
    # multiple version in depslist -> error  ok
    #
    # multiple version in hdlist -> error    ok
    #
    # multiple in dir -> warning             ok
    #
    
    my $ok = 1;
    my $OK = 1;
    my %depslist;
    my %depslistname;
    my $i = 1;
    print {$LOG} "checkDiscs: duplicate version in $depslist:";
    while (<A>){
	my ($pkg,$name) = ((split)[0]) =~ /((.*)-[^-]+-[^-]+\.[^:]+)/;
	$depslist{$pkg} and do { print {$LOG} "\n$pkg"; $ok=0};
	$depslistname{$name} and do { print {$LOG} "\n$name"; $ok=0};
	$depslist{$pkg} = $i;
	$depslistname{$name} = $i++;
    }
    close A;
    $ok or $OK=0;
    $ok ? print {$LOG} " OK\n" : print {$LOG} "\nFAILED\n";
    my %hdlist;
    print {$LOG} "\ncheckDiscs: duplicate version in hdlists:";
    my $maxidx;
    my %rpm;
    my (@rnh,@hnd,@duprep,@rnd,@hnr,%rpmKeys);
    my $ok = 1;
    for (my $i = 1; $i < @$hdlists; $i++){
	my $packer = new packdrake($hdlists->[$i]);
	my $j;
	foreach my $file (@{$packer->{files}}) {
	    my ($rpm,$key) = $file =~ /([^:]*)(?::(.*))?/;
	    $rpmKeys{key}{$rpm} = $key ? $key : $rpm;
	    $rpmKeys{rpm}{$rpmKeys{key}{$rpm}} = $rpm;
	    my $sok;
	    foreach my $c (@{$check->[$i]}){
	        my ($cd,$rep,$list) = @$c;
		$discsFiles->[$cd]{$rep}{$list}{$rpmKeys{key}{$rpm}} and $sok = 1;
	    }
	    $sok or push @hnr, [ $i, $rpm ];
	    $depslist{$rpm} or push @hnd, $rpm;
	    $hdlist{all}{$rpm} and do { print {$LOG} "\n$rpm"; $ok = 0 };
	    $hdlist{all}{$rpm} = 1;
	    $hdlist{cd}{$i}{$rpm}  = 1;
	    $depslist{$rpm} > $j and $j = $depslist{$rpm};
	    $depslist{$rpm} < $maxidx and print {$LOG} "ERROR checkDiscs: inconsistency in position between hdlist $i rpm $rpm and depslist.ordered\n"
	}
	foreach my $c (@{$check->[$i]}){
	    my ($cd,$rep,$list) = @$c;
	    foreach my $rpm (keys %{$discsFiles->[$cd]{$rep}{$list}}){
		$rpm{$rpmKeys{rpm}{$rpm}} and push @duprep, $rpm;
		$rpm{$rpmKeys{rpm}{$rpm}} = 1;
		$depslist{$rpmKeys{rpm}{$rpm}} or push @rnd,  [ $i, $cd, $rep, $rpm ];
		$hdlist{cd}{$i}{$rpmKeys{rpm}{$rpm}} or push @rnh, [ $i, $rpm ]
	    }
	}
	$maxidx = $j;
    }
    $ok or $OK=0;
    $ok ? print {$LOG} " OK\n" : print {$LOG} "\nFAILED\n";

    my @dnh;
    my $ok = 1;
    print {$LOG} "\ncheckDiscs: in depslist, not on discs:";
    foreach my $rpm (keys %depslist){
	$hdlist{all}{$rpm} or do { push @dnh, $rpm };
	$rpm{$rpm} or do { $ok = 0; print {$LOG} "\n$rpm"};
    }
    $ok or $OK=0;
    $ok ? print {$LOG} " OK\n" : print {$LOG} "\nFAILED\n";

    print {$LOG} "\ncheckDiscs: in depslist, not in hdlists:";
    @dnh ? do { print {$LOG} " FAILED\n" and $OK = 0 } : print {$LOG} " OK\n";
    foreach (@dnh){
	print {$LOG} "$_\n"
    }
    print {$LOG} "\ncheckDiscs: in hdlists, not on discs:";
    @hnr ? do { print {$LOG} " FAILED\n" and $OK = 0 } : print {$LOG} " OK\n";
    foreach (@hnr){
	print {$LOG} "hdlist $_->[0] rpm $_->[3]\n"
    }
    print {$LOG} "\ncheckDiscs: in hdlists, not in depslist:";
    @hnd ? do { print {$LOG} " FAILED\n" and $OK = 0 } : print {$LOG} " OK\n";
    foreach (@hnd){
	print {$LOG} "$_\n"
    }
    print {$LOG} "\ncheckDiscs: on discs, not in hdlist:";
    @rnh ? print {$LOG} " WARNING\n": print {$LOG} " OK\n";
    foreach (@rnh){
	print {$LOG} "hdlist $_->[0] rpm $_->[1]\n"
    }
    print {$LOG} "\ncheckDiscs: on discs, not in depslist:";
    @rnd ? print {$LOG} " WARNING\n": print {$LOG} " OK\n";
    foreach (@rnd){
	print {$LOG} "hdlist $_->[0] cd $_->[1] rep $_->[2] missing rpm $_->[3]\n"
    }
    print {$LOG} "\ncheckDiscs: duplicate version on discs:";
    @duprep ? print {$LOG} " WARNING\n": print {$LOG} " OK\n";
    foreach (@duprep){
	print {$LOG} "$_\n"
    }
    return $OK
}

#
# check depslist, depslists.ordered and hdlists
#
sub checkcds{
    my (@tops) = @_;
    
    my $top = "$tops[0]/";
    my $depslist = "$tops[0]/Mandrake/base/depslist.ordered";
    -f $depslist or print "ERROR: could not find $depslist file\n" and return 0;
    my $hdlists = "$top/Mandrake/base/hdlists";
    local *A; open A, $hdlists or die "unable to open $hdlists";
    my @hdlist = (0);
    my @discsFiles;
    my @check = (0);
    while (<A>){
	my ($hdlist, $dir, undef) = split;
	my ($hdid) = $hdlist =~ /(\d*).cz/;
	my $hdfile = "$tops[0]/Mandrake/base/$hdlist";
	push @hdlist, $hdfile;
	push @check, [[ $hdid, $dir, 1 ]];
	-f $hdfile or print "ERROR: could not find $hdfile file\n" and return 0;
	local *C;
	if (! opendir C, "$top/$dir"){
	    foreach (@tops){
		opendir C, "$_/$dir" or next;
		last
	    }
	}
	foreach (readdir C){
	    /(.*)\.rpm/ or next;
	    $discsFiles[$hdid]{$dir}{1}{$1} = 1
	}

    }
    checkDiscs(\@hdlist,$depslist,\@discsFiles,\@check)
}

sub checkcds_old{
    my ($tops,$first,$log) = @_;
    my $LOG; if ($log) { my $LOG = $log } else { open $LOG, ">&STDERR" }
    my $i;
    my $top;

    if ($first) { $top = $tops->[$first]} else { while (!$tops->[$i]){$i++}; $top = $tops->[$i]} ;

    local *A; open A, "$top/Mandrake/base/depslist.ordered" or print {$LOG} "ERROR: unable to open $top/Mandrake/base/depslist.ordered" and return 0;
    my %depspackages;
    my %dup;
    my $ok = 1;
    my $OK=1;
    print {$LOG} "Duplicate version: ";
    while (<A>){
	my ($pkg,$name) = ((split)[0]) =~ /((.*)-[^-]+-[^-]+\.[^:]+)/;
	$dup{$pkg} and do { print {$LOG} "\n$pkg"; $ok=0 ; $OK=0};
	$dup{$name} and do { print {$LOG} "\n$name"; $ok=0 ; $OK=0};
	$depspackages{$pkg} = 1;
	$dup{$pkg} = 1;
	$dup{$name} = 1;
    }
    $ok ? print {$LOG} " OK\n" : print {$LOG} " FAILED\n";

    my %hdlist;
    my %rep;
    my $num;
    local *A; open A, "$top/Mandrake/base/hdlists" or die "unable to open $top/Mandrake/base/hdlists";
    while (<A>){
	my ($hdlist, $dir, undef) = split;
	$num++;
	local $_;
	local *B; open B, "packdrake -l $top/Mandrake/base/$hdlist|" or die "unable to open packdrake $top/Mandrake/base/$hdlist|";
	<B>;
	print {$LOG} "\nIn $hdlist, not in depslist:";
	my $ok = 1;
	my $p;
	my $k;
	my %key;
	while (<B>){
	    $p = (split)[2];
	    if ($p =~ /(.*):(.*)/){
		$p = $1;
		$k = $2;
		$key{$2} = $1
	    }else { $key{$p} = $p } 
	    # $p =~ s/(\.(i386|i486|i586|i686|noarch))?$//;
	    $hdlist{$p} = 1;
	    if (!$depspackages{$p}) {print {$LOG} "\n$p"; $ok=0; $OK=0}
	}
	$p or do { print {$LOG} "$hdlist is empty\n" ; $OK=0};
	$ok and print {$LOG} " OK\n";
	local *C;
	opendir C, "$tops->[$num]/$dir" or opendir C, "$top/$dir";
	my $ok = 1;
	print {$LOG} "\n\nIn $tops->[$num]/$dir, not in depslist:";
	readdir C;
	readdir C;
	foreach (readdir C){
	    s/\.rpm// or next;
	    $rep{$key{$_}} = 1;
	    if (!$depspackages{$key{$_}}) {print {$LOG} "\n$_"; $ok=0; $OK = 0}
	}	
	$ok ? print {$LOG} " OK\n" : print {$LOG} " FAILED\n";
    }

    print {$LOG} "\n\nIn depslist, not in hdlist*.cz:";
    my $ok = 1;
    foreach (keys %depspackages){ 
	if (!($hdlist{$_})) {print {$LOG} "\n$_"; $ok=0; $OK=0}
    }
    $ok ? print {$LOG} " OK\n" : print {$LOG} " FAILED\n";

    print {$LOG} "\n\nIn depslist, not in RPMS*:";
    my $ok = 1;
    foreach (keys %depspackages){ 
	if (!$rep{$_}) {print {$LOG} "\n$_"; $ok=0; $OK=0}
    }
    $ok ? print {$LOG} " OK\n" : print {$LOG} " FAILED\n";
    print {$LOG} "\n";
    $OK
}

#
# regexp version
#
sub cleanrpmsrate2 {
    my ($rpmsrate,@rpms) = @_;
    my $LOG; open $LOG, ">&STDERR";
    my @rpm;
    foreach (@rpms){
	-d or print {$LOG} "ERROR: $_ is not a directory\n" and next;
	local *A; opendir A, $_;
	push @rpm, grep { s/-[^-]+-[^-]+\.[^.]+\.rpm// } readdir A;
    }
    my %done;
    my (@flags,@c);
    my ($mod,$text,$prev,$rate,$current);
    my (%rate,%section);
    local *A; open A, $rpmsrate or print {$LOG} "ERROR: cannot open $rpmsrate\n";
    while (<A>){
	s/#.*//;
	/^\s*$/ and $text .= "\n" and next;
	if (/^(\S+)/) {
	    $text .= "$1\n";
	    $current = $1;
	    @flags = ($current);
	    next
	}
	my ($indent,$r,$flags,$data) = /^(\s*)([1-5]?)((?:\s+(?:(?:!\s*)?[0-9A-Z_]+(?:"[^"]*")?(?:\s+(?:\|\|\s+)?)*)+\s+)|\s+)(.*)$/;
	if ($r) {
	    $rate = $r
	}elsif ($prev){
	    chop $indent;
	    $r = $prev
	}
	push @flags, split ' ', $flags; 
	$data or $text .= "$indent$r$flags" and next;
	my ($postfix) = $data =~ /(\s*)$/;
	my @k;
	foreach my $n (split ' ', $data) {
	    @c = grep { /^$n$/ } @rpm;
	    map { if ((!$done{$_}[1] || $current eq "INSTALL") && $done{$_}[0] ne $current ) { push @k, $_; @{$done{$_}} = @flags }} @c
	} 
	if (@k) { $text .= "$indent$r$flags@k$postfix\n"; $prev = '' } else { $prev = $r};
	@rate{@k} = map $rate, @k;
	push @{$section{$current}}, @k
    }
    close A;
    if (@rpms){
	if (open A, ">$rpmsrate") {
	    print A $text;
	    close A
	}else{
	    @rpms and print {$LOG} "ERROR: cannot open $rpmsrate for writing\n";
	    print $text
	}
    }
    [\%rate,\%section];
}


sub cleanrpmsrate {
    my ($rpmsrate,$output,$norpmsrate,@rpms) = @_;
    $norpmsrate ||= [];
    my $LOG; open $LOG, ">&STDERR";
    local *A; open A, $rpmsrate or print {$LOG} "ERROR: cannot open $rpmsrate\n";
    my @rpmsrate;
    my %potloc;
    # must preread to get locale guessed packages
    # postfix is just used not to break the diff when checking if the result is correct
    while (<A>){
	chomp;
	s/#.*//;
	#s/\s*$//;
	/^(\s*)$/ and push @rpmsrate, [ 0, 0, 0, []] and next;
	if (/^(\S+)(.*)$/) {
	    push @rpmsrate, [ 0, 0, $1, [$1], $2];
	    next
	}
	# FIXME hack because entry like "  GNOME" were not matched by the following regexp
	if (/^(\s*)([0-9A-Z_]+)$/) {
	    push @rpmsrate, [ $1, '', $2, []];
	    next
	}
	my ($indent,$r,$flags,$data) = /^(\s*)([1-5]?|\s*)((?:\s*(?:(?:!\s*)?[0-9A-Z_]+(?:"[^"]*")?(?:\s+(?:\|\|\s+)?)*)+\s+)|\s+)(.*)$/;
	my ($postfix) = $data =~ /(\s*)$/;
	my @data;
	my $i;
	foreach ([$data =~ /(?:^|\s)(\S+)-(?:\S+)\s+\1-(?:\S+)(?:\s|$)/g],[split ' ', $data]){
	    $data[$i++] = [ @$norpmsrate ? grep { my $r = $_; $r if (!grep { $r =~ /$_/ } @$norpmsrate) } @$_ : @$_ ]
	}
	map $potloc{$_} = [], @{$data[0]};
	push @rpmsrate, [ $indent,$r, $flags, $data[1], $postfix ];
    }
    my (%rpms,$text);
    my (%rate,%section);
    my %locale;
    foreach my $dir (@rpms){
	-d $dir or print {$LOG} "ERROR cleanrpmsrate: $dir is not a directory\n" and next;
	local *A; opendir A, $dir;
	foreach (readdir A) { 
	    my $rpm = $_;
	    s/-[^-]+-[^-]+\.[^.]+\.rpm$// or next;
	    grep { $rpm =~ /$_/ } @$norpmsrate and next;
	    if (/(.*?)([_-]*[\d._]*)-devel$/ || /(kernel.*)(-[^.]+\.[^.]+\.[^.]+\.[^.]+mdk)$/){ 
		if (!$rpms{$1}){ $rpms{$1} = $2 }
		elsif (rpmtools::version_compare($2,$rpms{$1}) > 0){ $rpms{$1} = $2 }
	    }elsif (my ($pg,$loc) = /^(.*)-([^-+]+)$/){
		if ($potloc{$pg}){
		    my %header; 
		    tie %header, "RPM::Header", "$dir/$rpm" or print "ERROR: $RPM::err\n" and next;
		    # FIXME the ending 3 is a hack for kde3 in contrib
		    grep { s/locales-// && $loc =~ /^$_(_|$)/ } @{$header{REQUIRENAME}} and push @{$locale{$pg}}, $loc
		}
	    }
	}
    }
    my %done;
    my $current;
    my @flags;
    my $rate;
    my $prev;
    foreach (@rpmsrate){
	if (!$_->[0]){
	    $text .= "@{$_->[3]}$_->[4]\n";
	    if ($_->[2]){
		$current = $_->[2];
		@flags = ($current)
	    }
	    next
	}
	my ($indent,$r,$flags,$data,$postfix) = @$_;
	if ($r) {
	    $rate = $r
	}elsif ($prev){
	    chop $indent;
	    $r = $prev;
	}
	push @flags, split ' ', $flags; 
	my $ct = "$flags$postfix";
	@$data or $ct =~ /\S/ and $text .= "$indent$r$ct\n" and next;
	my @k;
	foreach (@$data) {
	    my $c = $_;
	    if (($done{$_}[1] && $current ne "INSTALL") || $done{$_}[0] eq $current ) { next }
	    my ($d) = /(.*)-[^-]+/;
	    my ($a,$b); 
	    if (((($current ne "INSTALL") && (s/(-devel)//)) ? $b = "-devel" : /^kernel/) && ($rpms{$_} || ($rpms{"lib$_"} and $a = "lib"))) { 
		my $d = "$a$_" . $rpms{"$a$_"} . "$b"; 
		if ($done{$d}[0] ne $current) { @{$done{$d}} = @flags; push @k, $d }
	    }
	    if ($locale{$d}){
		push @k, map { if (!$done{"$d-$_"}[1] && $done{"$d-$_"}[0] ne $current){ @{$done{"$d-$_"}} = @flags; "$d-$_"} else { next } } sort @{$locale{$d}}
	    }else{
	        push @k, $c;
		@{$done{$c}} = @flags
	    }
	} 
	if (@k) { $text .= "$indent$r$flags@k$postfix\n"; $prev = 0 } else { $prev = $r };
	@rate{@k} = map $rate, @k;
	push @{$section{$current}}, @k
    }
    close A;
    if (%rpms || $output){
	if (@rpms || $output){
	    $output ||= $rpmsrate;
	    if (open A, ">$output") { 
		print A $text;
		close A 
	    } else { 
		print {$LOG} "ERROR cleanrpmsrate: cannot open $rpmsrate for writing\n";
		print $text
	    }
	}
    }
    [\%rate,\%section];
}

sub imageSize {
    my ($file) = @_;
    my ($width, $height, $err) = imgsize($file);

    return ((defined $width) ?
    [ $width, $height ] :
    "error: $err")
}

sub printDiscsFile{
    my ($config,$discsFiles,$PRINT,$metagroups) = @_;
    local *A;
    my $a;
    if ($PRINT) { open A, ">$PRINT"; $a = \*A } else { $a = $config->{LOG}}
    my %done;
    for(my $cd; $cd < @$discsFiles; $cd++){
	$discsFiles->[$cd] or next;
	print {$config->{LOG}} "discsFiles: $cd\n";
	my $cdname = $config->{disc}[$cd]{name} || $cd;
	foreach my $rep (keys %{$discsFiles->[$cd]}){
	    foreach my $list (keys %{$discsFiles->[$cd]{$rep}}){
		foreach my $rpm (sort keys %{$discsFiles->[$cd]{$rep}{$list}}){
		    $done{$rpm} = 1;
		    #$rpm =~ /src$/ and next;
		    print {$a} "Disc$cdname $rpm\n";
		}
	    }
	}
    }
    $metagroups or return;
    foreach (@$metagroups){
	my $groups = $_->[0];
	for(my $i; $i < @$groups; $i++){
	    foreach (keys %{$groups->[$i]{params}{info}}){
		$done{$groups->[$i]{rpmkey}{rpm}{$_}} and next;
		if ($groups->[$i]{brokendeps}{$_} == 2){
		    ref $groups->[$i]{missingdeps}{$_} or print {$a} "ERROR printDiscsFile: this should not happen, missingdeps is not a table for $_ (group $i)\n" and next;
		    print {$a} "MISSING_DEPENDENCIES $_ @{$groups->[$i]{missingdeps}{$_}}\n"
		}else{
		    print {$a} "REJECTED $_\n"
		}
	    }
	}
    }
    close A;
}

sub printBatchFile{
    my ($config,$discsFiles,$PRINTSCRIPT) = @_;
    if (-f $PRINTSCRIPT) {
	my $err = unlink $PRINTSCRIPT;
	if (!$err) { print {$config->{LOG}} "Unlinking failed $PRINTSCRIPT: $!\n"; return};
    }
    my $err = copy $config->{configfile}, $PRINTSCRIPT;
    if (!$err) { print {$config->{LOG}} "Linking failed $PRINTSCRIPT: $!\n"; return};
    local *A; open A, ">>$PRINTSCRIPT";
    print A "END\n";
    for(my $cd; $cd < @$discsFiles; $cd++){
	$discsFiles->[$cd] or next;
	print {$config->{LOG}} "discsFiles: $cd\n";
	print A "CD $cd\n";
	foreach my $rep (keys %{$discsFiles->[$cd]}){
	    print A " REP $rep\n";
	    foreach my $list (keys %{$discsFiles->[$cd]{$rep}}){
	    	print A "  LIST $list\n";
		foreach my $rpm (keys %{$discsFiles->[$cd]{$rep}{$list}}){
		    $rpm and print A "   $rpm $discsFiles->[$cd]{$rep}{$list}{$rpm}\n";
		}
	    }
	}
    }
}

sub readBatchFile{
    my ($file) = @_;
    local *A; open A, "$file" or print "ERROR readBatchFile: could not open $file for reading\n" and return 0;
    my @discsFiles;
    my @cd;
    while (<A>){ /^END/ and last }
    my ($cd,$rep,$list);
    while (<A>){
	if (/^CD (\d+)/){ $cd = $1; next }
	if (/^ REP (\S+)/){ $rep = $1; next }
	if (/^  LIST (\d+)/){ $list = $1; next }
	if (/^   (\S+) (\S+)/){ 
	    $discsFiles[$cd]{$rep}{$list}{$1} = $2;
	    push @{$cd[$cd]{$rep}{$list}{$2}}, [ 1, "$1.rpm" ];
	    next 
	}
    }
    return (\@discsFiles, \@cd)
}

sub config{
    my ($file,$config,$functions) = @_;
    open F,$file or die "ERROR config: cannot open $file\n";
    while (<F>){ chomp ; /^#/ or !$_ or last}
    chomp;
    $config->{name} = (split)[0];
    my $cd;
    my $fn;
    my $nk;
    my $type;
    my @todo;
    my $discMax;
    while (<F>){
	/^#/ and next;
	chomp;
	$_ or next;
	s/#.*//;
	if (/^LIST /){
	    if (/^LIST (\d+)(?:\s+(\S.*))*/) {
		$cd = $1;
		push @{$config->{list}[$cd]{filelist}},  (split ' ',$2);
		$type = 1;
		print LOG "LIST $1 $2\n"
	    }else {
		$nk = 1;
		print LOG  "WARNING: LIST syntax error ($_)\n";
		print LOG "         LIST <list number> <file list 1> <file list 2> ... <file list n>\n"
	    }
	} elsif (/^DISC /){
	    if (/^DISC (\d+)\s+(\d+)\s+(\S+)\s+DISC\s+(\d+)\s+(.*)/) { 
		$config->{disc}[$1]{size} = $2;
		$config->{disc}[$1]{serial} = $3;
		$config->{disc}[$1]{name} = $4;
		$config->{disc}[$1]{longname} = $5;
		$cd = $1;
		$type = 2;
		$fn = 0;
		$4 > $discMax and $discMax=$4;
		print LOG "DISC $1 $2 $3 $4\n"
	    }elsif(/^DISC (\d+)\s+(\d+)\s+(\S+)\s+(.*)/){ 
		$config->{disc}[$1]{size} = $2;
		$config->{disc}[$1]{serial} = $3;
		$config->{disc}[$1]{name} = 0;
		$config->{disc}[$1]{longname} = $4;
		$cd = $1;
		$type = 2;
		$fn = 0;
		$4 > $discMax and $discMax=$4;
		print LOG "DISC $1 $2 $3 $4\n"
	    }else{
		$nk = 1;
		print LOG "WARNING: DISC syntax error ($_)\n";
		print LOG "         DISC <cd number> <cd size> <cd serial name> DISC <real cd number> <disc name>\n";
	    }
	} elsif (/^END/){
	    last	
	}else {
	    $type == 1 and do {
		push @{$config->{list}[$cd]{packages}}, [split];
		next
	    };
	    $type == 2 and do {
		my ($prog,@args) = split;
		print LOG "CALLING $prog -- @args\n";
		push @todo, [$prog, \@args, $cd, $fn];
		$fn++;
		next
	    }
	}
    }
    $config->{configfile} = $file;
    $config->{discMax} = $discMax;
    foreach (@todo){
	my ($prog,$args,$cd,$fn) = @$_;
	$functions->{$prog} and do {
	    print LOG "FUNCTION $prog\n";
	    my $todo = parseCommandLine($prog,$args,$functions->{$prog});
	    @$args and usage($prog,$functions->{$prog},11);
	    foreach (@$todo){
		print LOG "$_->[2]\n";
		&{$_->[0]}($cd,$fn,@{$_->[1]}) or print LOG "ERROR: $_->[2]\n" and $nk = 1;
	    }
	}
    }
    $nk and return 0;
    printTable($config);
    1
}

1

#
# Changelog
# 
# 2002 02 27
#
# make the locale constraint free on the right for cleanrpmsrate locale addition (kde-i18n-zh_BG and such)
#
# 2002 03 03
#
# fix typo in checkdiscs
#
# 2002 03 04 
#
# fix checkcds pb with check[0] used.
#
# 2002 03 07
#
# add possibility to remove package from rpmsrate
#
# 2002 03 12
#
# add all .*kernel- in rpmsrate