package Mkcd::Tools;

our $VERSION = '1.0.0';

use strict;
use File::NCopy qw(copy);       
use Image::Size qw(:all);
use Mkcd::Commandline qw(parseCommandLine usage);
use Digest::MD5;
use MDK::Common qw(all any cat_);
require Exporter;
use URPM;
our @ISA = qw(Exporter);
our @EXPORT = qw(printTable getTracks du cpal checkcds checkDiscs cleanrpmsrate imageSize printDiscsFile readBatchFile printBatchFile config compute_md5 log_ include_md5 convert_size compute_files_md5 fix_dir filter_path find_list);
our ($GB, $MB, $KB, $INFO_OFFSET, $SIZE_OFFSET, $SKIP);
$INFO_OFFSET = 883;
$SIZE_OFFSET = 84;
$SKIP = 15;

$KB = 1024;
$MB = 1024 * 1024;
$GB = $MB * 1024;

=head1 NAME

tools - mkcd tools

=head1 SYNOPSYS

    require mkcd::tools;

=head1 DESCRIPTION

<mkcd::tools> includes mkcd tools.

=head1 SEE ALSO

mkcd

=head1 COPYRIGHT

Copyright (C) 2000,2001,2002,2003,2004 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.

=head1 CREDITS

md5 code highly inspired from Redhat anaconda md5 in ISO code

=cut

sub printTable {
    my ($a, $log) = @_;
    my $LOG; if ($log) { $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) { $LOG = $log } else { open $LOG, ">&STDERR" }
    my @tracks = split ',',$tracks;
    my @t;
    foreach (@tracks) {
	/(\d+)/ and push @t, $1;
	/(\d+)-(\d+)/ and push @t, $1..$2	
    }
    my @ntracks;
    my %done;
    for (my $i = $#t; $i >= 0; $i--) {
	push @ntracks, $t[$i] if !$done{$t[$i]};
	$done{$t[$i]}=1
    }
    \@ntracks;
}

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

sub cpal {
    my ($source, $dest, $exclude, $verbose, $log) = @_;
    my $LOG; if ($log) { $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 $ok;
	if (-d $dest) { my ($filename) = $source =~ m,([^/]*)$,; $dest .= "/$filename" }
	$ok = link $source, $dest;
	$verbose and print $LOG "cpal: link $source -> $dest\n"; 
	if (!$ok) { 
	    print $LOG "Linking failed $source -> $dest: $!, trying to copy\n"; 
	    $ok = copy $source, $dest; 
	    if (!$ok) { 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" }
    
    print $LOG "checkDiscs: depslist $depslist\n";
    #
    # depslist hdlist consistency -> error 			  ok (not the same as install one, but duplicate will break anyway)
    #
    # in hdlist, not in depslist -> error		    	  ok
    # 
    # in hdlist, not in dir -> error         			  ok 
    #
    # in hdlist with packdrake, no with parsehdlist -> error 
    #
    # 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;
    if ($depslist) {
	my $i = 1;
	open my $A, $depslist or print $LOG "ERROR: unable to open $depslist" and return 0;
	print $LOG "checkDiscs: duplicate version in $depslist:";
	while (<$A>) {
	    my ($pkg, $name, $arch) = ((split)[0]) =~ m/((.*)-[^-]+-[^-]+\.([^:]+))/;
	    $depslist{$pkg} and do { print $LOG "\n$pkg"; $ok = 0 };
	    $depslistname{$arch}{$name} and do { print $LOG "\n$name"; $ok = 0 };
	    $depslist{$pkg} = $i;
	    $depslistname{$arch}{$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, %parsehdlist, @pnh, @hnp);
    $ok = 1;
    my $parsehdlist;
    my $path = $0;
    $path =~ s,[^/]*$,,;
    if (-x "$path/parsehdlist") {
        $parsehdlist = "$path/parsehdlist"
    } elsif (-x "/usr/bin/parsehdlist") {
	$parsehdlist = "/usr/bin/parsehdlist"
    } else {
	my $err = system('parsehdlist');
	if ($err) {
	    $parsehdlist = "parsehdlist"	
	} else {
	    print $LOG, "ERROR checkDiscs: could not find parsehdlist command ($!)\n";
	    return 0
	}
    }
    for (my $i = 1; $i < @$hdlists; $i++) {
	if (! -f $hdlists->[$i]) {
	    print $LOG "\nWARNING checkDiscs: $hdlists->[$i] is empty, ignoring\n";
	    next
	}
	my $packer = new packdrake($hdlists->[$i]);
	my $j;
	foreach my $file (@{$packer->{files}}) {
	    my ($rpm, $key) = $file =~ /([^:]*)(?::(.*))?/;
	    $rpmKeys{key}{$rpm} = $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 ];
	    $hdlist{all}{$rpm} and do { print $LOG "\n$rpm"; $ok = 0 };
	    $hdlist{all}{$rpm} = 1;
	    $hdlist{cd}{$i}{$rpm}  = 1;
	    if ($depslist) {
		$depslist{$rpm} or push @hnd, $rpm;
		$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 ($j < $maxidx)\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 && $depslist{$rpmKeys{rpm}{$rpm}} or push @rnd,  [ $i, $cd, $rep, $rpm ];
		$hdlist{cd}{$i}{$rpmKeys{rpm}{$rpm}} or push @rnh, [ $i, $rpm ]
	    }
	}
	open my $PAR, "$parsehdlist $hdlists->[$i] |";
	while (<$PAR>) {
	    chomp;
	    s/\.rpm$//;
	    $parsehdlist{$i}{$_} = 1;
	    $hdlist{cd}{$i}{$_} and next;
	    push @pnh, $_
	}
	foreach my $p (keys %{$hdlist{cd}{$i}}) {
	    $parsehdlist{$i}{$p} or push @hnp, $p
	}
	$maxidx = $j;
    }
    $ok or $OK = 0;
    $ok ? print $LOG " OK\n" : print $LOG "\nFAILED\n";

    my @dnh;
    $ok = 1;
    if ($depslist) {
	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: in hdlists, not see with parsehdlist:";
    @hnp ? do { print $LOG " FAILED\n" and $OK = 0 } : print $LOG " OK\n";
    foreach (@hnp) {
	print $LOG "$_\n"
    }
    print $LOG "\ncheckDiscs: see with parsehdlist, not with packdrake:";
    @pnh ? do { print $LOG " FAILED\n" and $OK = 0 } : print $LOG " OK\n";
    foreach (@pnh) {
	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;
    my $media_info;
    if (-d "$tops[0]/media/media_info") {
	$depslist = "$tops[0]/media/media_info/depslist.ordered";
	$media_info = "media/media_info"
    } else {
	$depslist = "$tops[0]/Mandrake/base/depslist.ordered";
	$media_info = "Mandrake/base"
    }
    -f $depslist or print "ERROR: could not find depslist $depslist file\n" and return 0;
    my $hdlists = "$top/$media_info/hdlists";
    open my $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 =~ /hdlist(.*).cz/;
	my $hdfile = "$top/$media_info/$hdlist";
	push @hdlist, $hdfile;
	push @check, [[ $hdid, $dir, 1 ]];
	-f $hdfile or print "ERROR: could not find $hdfile file\n" and return 0;
	print "Reading $top/$dir\n";
	my $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 cleanrpmsrate {
    my ($rpmsrate, $output, $norpmsrate, $reprpms, $urpm) = @_;
    $norpmsrate ||= [];
    my $LOG; open $LOG, ">&STDERR";
    open my $A, $rpmsrate or print $LOG "ERROR: cannot open $rpmsrate\n";
    my (@rpmsrate, %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, '', [] ] and next;
	if (/^(\S+)(.*)$/) {
	    push @rpmsrate, [ 0, 0, $1, [], $2 ];
	    next
	}
	if (/^(\s*)([1-5])?(\s?[0-9A-Z_]+)$/) {
	    push @rpmsrate, [ $1, $2, $3, [] ];
	    next
	}
	my ($indent, $r, $flags, $data) = /^(\s*)([1-5])?(\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 ? any { my $r = $_; $r if !any { $r =~ /$_/ } @$norpmsrate } @$_ : @$_ ]
	}
	$potloc{$_} = [] foreach  @{$data[0]};
	push @rpmsrate, [ $indent,$r, $flags, $data[1], $postfix ];
    }
    my (%rpms, $text);
    my (%rate, %section, %keyword);
    my (%locale, %localized_pkg, %kernel_version);
    my $kernel_like = "((?:(?:NVIDIA_)?kernel|NVIDIA_nforce|cm2020).*)";
    my $dkms_like = "(.*)([-_])kernel-([0-9]+(?:\.[0-9]+){2,3}-[0-9]+(?:.[^.]+){0,2}mdk)(.*)";
    my $rpmsrate_dkms_like = "(.*[-_]kernel)(.*)";
    my $urpm2 = new URPM;
    foreach my $dir (keys %$reprpms) {
	foreach (@{$reprpms->{$dir}}) { 
	    my $rpm = "$_.rpm";
	    my $key = $_;
	    s/-[^-]+-[^-]+\.[^.]+$// or next;
	    any { $rpm =~ /$_/ } @$norpmsrate and next;
	    if (/(.*?)([_-]*[\d._]*)-devel$/ || /^$kernel_like(-[^.]+(?:\.[^.]+){3,6}mdk)$/) { 
		if (!$rpms{$1}) { $rpms{$1} = $2 }
		elsif (URPM::ranges_overlap("== $2", "> $rpms{$1}")) { $rpms{$1} = $2 }
		if (/^$kernel_like-(\d+\.\d+)(.*)/) { $rpms{"$1-$2"} = $3}
	    } elsif (/^$dkms_like$/) {
		my $vname = "$1$2kernel$4";
		if (!$rpms{$vname}) { $rpms{$vname} = $3 }
		elsif (URPM::ranges_overlap("== $3", "> $rpms{$vname}")) { $rpms{$vname} = $3 }
	    } elsif (my ($pg, $loc) = /^(.*)-([^-+]+)$/) {
		if ($potloc{$pg}) {
		    my $pkg;
		    $pkg = $urpm->{rpm}{$urpm->{rpmkey}{key}{$key}} if ref $urpm;
		    if (!$pkg) {
			my $id = $urpm2->parse_rpm("$dir/$rpm");
			$pkg = $urpm2->{depslist}[$id];
		    }
		    if (!$pkg) {
			print "ERROR cleanrpmsrate: parse_rpm $dir/$rpm ($key) failed\n";
			next
		    }
		    # some i18n packages does not require the same locale, e.g. kde-i18n-nb and nn requires locales-no 
		    # if (grep { s/locales-// && $loc =~ /^$_(_|$)/ } @{$header{REQUIRENAME}}) {
		    if (any { /^locales-...?$/ } $pkg->requires) {
			push @{$locale{$pg}}, $loc;
			$localized_pkg{"$pg-$loc"} = 1
		    }
		}
	    }
	}
    }
    my (%done, @flags, $prev, @tree_rate, $prev_level);
    foreach (@rpmsrate) {
	if (!$_->[0]) {
	    $text .= "$_->[2]$_->[4]\n";
	    if ($_->[2]) {
		@flags = $_->[2]
	    }
	    next
	}
	my ($indent, $r, $flags, $data, $postfix) = @$_;
	my $level = (length $indent)/2 - 1;
	my $rate;
	if ($r) {
	    #print "tree_rate[$level] = $r\n";
	    $rate = $r;
	    $tree_rate[$level] = $r
	} else {
	    if (@$data) {
		if ($level > $prev_level) {
		    $level-- 
	        } else {
		    # fix a syntax error in rpmsrate such as
		    # A
		    #   1 toto
		    #   B tata <---
		    #     4 titi
		    @$data = ()
	        }
	    }
	    $rate = $tree_rate[$level];
	}
	$prev_level = $level;
	@flags = @flags[0 .. $level];
	push @flags, split(' ', $flags);
	#push @flags, grep { s/\s//; !/(\|\||[A-Z_]+"[^"]+")/ } split(' ', $flags);
	my $flat_path = join ' ', @flags;
	if (!@$data) { $text .= "$indent$r$flags$postfix\n"; next }
	my @k;
	foreach (@$data) {
	    my $c = $_;
	    next if ref $done{$_} && any { $flat_path eq $_ } @{$done{$_}};
	    die "FATAL: too complicated flags for duplicate entry $c ($flat_path and " . join ',', @{$done{$_}} 
	         if $flags[0] ne "INSTALL" && @flags > 1 && any { 
			 my ($f) = $flat_path =~ /^[^ ]+ (.*)/;
			 !/^[^ ]+ (.*)/ || $1 ne $f
		 } @{$done{$_}};
	    my ($d) = /(.*)-[^-]+/;
	    my ($a, $b, $e);
	    my $do;
	    if (($flags[0] ne "INSTALL" && s/(-devel)// ? ($b = "-devel") : /^$kernel_like/) && ($rpms{$_} || (defined $rpms{"lib$_"} and $a = "lib") || (defined $rpms{"lib64$_"} and $a = "lib64"))) {
		$e = "$a$_" . $rpms{"$a$_"} . $b;
		$do = 1
	    } elsif (($flags[0] ne "INSTALL" && /^$rpmsrate_dkms_like$/ && $rpms{"$1$2"})) {
		$e = "$1-" . $rpms{"$1$2"} . "$2";
		$do = 1
	    }
	    if ($do) {
		$keyword{$c} = $e;
	       	if (! ref $done{$e} || $flags[0] eq "INSTALL" && ! (any { $flat_path eq $_ } @{$done{$e}}) || $flat_path =~ /DRIVER|HW/ ) { push @{$done{$e}}, $flat_path; push @k, $e }
	    }
	    if ($locale{$d} && $localized_pkg{$c}) {
		foreach (sort @{$locale{$d}}) {
		    next if any { $_ eq $flat_path } @{$done{"$d-$_"}};
		    push @{$done{"$d-$_"}}, $flat_path; 
		    push @k , "$d-$_"
		}
		next
	    }
	    push @k, $c;
	    push @{$done{$c}}, $flat_path
	} 
	if (@k) { $text .= "$indent$r$flags@k$postfix\n" }
	@rate{@k} = ($rate) x @k;
	my $path;
	foreach (@flags) {
	    $path .= $path ? "/$_" : $_;
	    push @{$section{$path}}, @k
	}
    }
    if (%rpms || $output) {
	if (%$reprpms || $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, \%keyword]
}

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

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

sub printDiscsFile {
    my ($config, $discsFiles, $PRINT, $metagroups) = @_;
    my (%done, $output);
    my $log = $config->{LOG};
    if ($PRINT) { open $output, ">$PRINT" } else { $output = $config->{LOG} }
    my $print_rejected = sub {
	my ($groups, $i, $rpm, $size, $install_cd) = @_;
	# FIXME ugly hack to display more rejected in multigroups buildings because discFiles is per disc and not per group.
	# $done{$groups->[$i]{urpm}{rpmkey}{rpm}{$rpm}} && ! ref $groups->[$i]{rejected}{$rpm} and return 1;
	$done{$groups->[$i]{urpm}{rpmkey}{rpm}{$rpm}} and return 1;
	$groups->[$i]{done}{rep}{$rpm} and return 1;
	if ($groups->[$i]{brokendeps}{$rpm} == 2) {
	    ref $groups->[$i]{rejected}{$rpm} or print $output "ERROR printDiscsFile: this should not happen, rejected is not a table for $rpm (group $i)\n" and next;
	}
	printf $output "REJECTED master disc $install_cd %10d %s $rpm (", $size, $groups->[$i]{limit}{$rpm} ? "limit" : "";
	
	my $ref = $groups->[$i]{rejected}{$rpm};
	if (ref $ref and %$ref) {
	    foreach my $l (keys %{$groups->[$i]{rejected}{$rpm}}) {
		print $output " [ list $l ] ";
		if (ref $groups->[$i]{rejected}{$rpm}{$l}) { 
		    print $output join(',', map { "$config->{rejected_options}{$_->[0]}: $_->[1]" } @{$groups->[$i]{rejected}{$rpm}{$l}})
		}
	    }
	} else {
	    print $output "not selected"
	}
	print $output ")\n";
	0
    };
    my %size;
    # this is not really correct as multiple list may have packages with the same name but different size
    if ($metagroups) {
	foreach my $iogroups (@$metagroups) {
	    foreach (@$iogroups) {
		my $groups = $_->[0];
		for (my $i; $i < @$groups; $i++) {
		    foreach my $rpm (keys %{$groups->[$i]{size}}) {
			foreach my $list (keys %{$groups->[$i]{size}{$rpm}}) { 
			    $size{$rpm} = $groups->[$i]{size}{$rpm}{$list}[0] if $size{$rpm} < $groups->[$i]{size}{$rpm}{$list}[0] 
			}
		    }
		}
	    }
	}
    }
    for (my $cd; $cd < @$discsFiles; $cd++) {
	$discsFiles->[$cd] or next;
	print $log "discsFiles: $cd\n";
	my $cdname = $config->{disc}[$cd]{label};
	foreach my $rep (keys %{$discsFiles->[$cd]}) {
	    foreach my $list (keys %{$discsFiles->[$cd]{$rep}}) {
		if (!$metagroups) {
		    foreach my $rpm (sort keys %{$discsFiles->[$cd]{$rep}{$list}}) {
			#$done{$rpm} = 1;
			#$rpm =~ /src$/ and next;
			printf $output "$cdname $rpm\n", $size{$rpm};
		    }
		} else {
		    foreach my $rpm (sort { $size{$a} <=> $size{$b} } keys %{$discsFiles->[$cd]{$rep}{$list}}) {
			printf $output "$cdname %10d $rpm\n", $size{$rpm};
		    }
		}
	    }
	}
    }
    if (!$metagroups) { $output = $config->{LOG} }
    foreach my $iogroups (@$metagroups) {
	foreach (@$iogroups) {
	    my $groups = $_->[0];
	    for (my $i; $i < @$groups; $i++) {
		my $install_cd = "$config->{disc}[$groups->[$i]{installDisc}]{label} ($groups->[$i]{installDisc})";
		if (ref $groups->[$i]{buildlist}) {
		    foreach (sort { $groups->[$i]{limit}{$b} <=> $groups->[$i]{limit}{$a} } sort { $size{$a} <=> $size{$b} } @{$groups->[$i]{buildlist}}) {
			$print_rejected->($groups, $i, $_, $size{$_}, $install_cd) and next;
			$done{$groups->[$i]{urpm}{rpmkey}{rpm}{$_}} = 1
		    }
		}
		foreach (sort { $size{$a} <=> $size{$b} } keys %{$groups->[$i]{urpm}{rpm}}) {
		    $print_rejected->($groups, $i, $_, $size{$_}, $install_cd)
		}
	    }
	}
    }
}

sub printBatchFile {
    my ($config, $discsFiles, $PRINTSCRIPT) = @_;
    # FIXME to please perl_checker
    my $log = $config->{LOG}; 
    if (-f $PRINTSCRIPT) {
	my $err = unlink $PRINTSCRIPT;
	if (!$err) { print $log "Unlinking failed $PRINTSCRIPT: $!\n"; return };
    }
    my $err = copy $config->{configfile}, $PRINTSCRIPT;
    if (!$err) { print $log "Linking failed $PRINTSCRIPT: $!\n"; return };
    open my $A, ">>$PRINTSCRIPT";
    print $A "END\n";
    for (my $cd; $cd < @$discsFiles; $cd++) {
	$discsFiles->[$cd] or next;
	print $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, $mkcd) = @_;
    my $log = $config->{LOG};
    open F,$file or die "ERROR config: cannot open $file\n";
    while (<F>) { chomp; /^#/ or !$_ or last }
    chomp;
    $config->{name} = (split)[0];
    my $match_val = q((?:([^"\s]+)|"([^\"]+)"));
    my $match_val2 = q(((?:[^"\s]*(?:[^"\s]+|"[^\"]+")[^"\s]*)+));
    my ($cd, $fn, $nk, $type, @todo, $discMax);
    $config->{virtual_disc} = [];
    my ($line, $a);
    while (<F>) {
	/^#/ and next;
	chomp;
	$_ or next;
	s/#.*//;
	my $b = s/\\\s*$//;
	if ($a) {
	    $line .= $_
	} else {
	    $line = $_ 
	}
	$a = $b;
	$a and next;
	local $_ = $line;
	if (/^list (.*)/) {
		my $line = $1;
		my @args;
		while ($line =~ s/$match_val2//) { my $a = $1; $a =~ s/"//g; push @args, $a }
		#print "config: args (" . ( join ' | ', @args) . ")\n";
		my $todo = parseCommandLine("list", \@args, $functions->{list});
		$cd = $todo->[0][1][0];
		#print "config: list $cd (@{$todo->[0][1]})\n";
		if (!$config->{list}[$cd]) {
		    @args and usage('list', $functions->{list}, "list $cd, list definition (@args) too many arguments");
		    foreach (@$todo) {
			log_("$_->[2]\n", $config->{verbose}, $log, 3);
			if (!&{$_->[0]}($cd, @{$_->[1]})) { log_("ERROR: $_->[2]\n", $config->{verbose}, $log); $nk = 1 }
		    }
		    $type = 1;
		    $fn = 0
		} else {
		    $type = 0;
		    log_("ERROR config: list $cd already defined, ignoring\n", $config->{verbose}, $log);
		}
	    # FIXME keep for compatibility
	} elsif (/^LIST /) {
	    if (/^LIST (\d+)(?:\s+(\S.*))*/) {
		$cd = $1;
		push @{$config->{list}[$cd]{filelist}},  (split ' ',$2) if $2;
		$type = 1;
		log_("LIST $1 $2\n", $config->{verbose}, $log, 3)
	    } else {
		$nk = 1;
		log_("WARNING: LIST syntax error ($_)\n", $config->{verbose}, $log);
		log_("         LIST <list number> <file list 1> <file list 2> ... <file list n>\n", $config->{verbose}, $log)
	    }
	} elsif (/^disc (.*)/) {
		my $line = $1;
		my @args;
		while ($line =~ s/$match_val2//) { my $a = $1; $a =~ s/"//g; push @args, $a }
		#print "config: args (" . ( join ' | ', @args) . ")\n";
		my $todo = parseCommandLine("disc", \@args, $functions->{disc});
		$cd = $todo->[0][1][0];
		#print "config: disc $cd (@{$todo->[0][1]})\n";
		if (!$config->{disc}[$cd]) {
		    @args and usage('disc', $functions->{disc}, "disc $cd, disc definition (@args) too many arguments");
		    foreach (@$todo) {
			log_("$_->[2]\n", $config->{verbose}, $log, 3);
			if (!&{$_->[0]}($cd, @{$_->[1]})) { log_("ERROR: $_->[2]\n", $config->{verbose}, $log); $nk = 1 }
		    }
		    $type = 2;
		    $fn = 0
		} else {
		    $type = 0;
		    log_("ERROR config: disc $cd already defined, ignoring\n", $config->{verbose}, $log);
		}
	    # FIXME keep for compatibility
	} elsif (/^DISC (.*)/) {
	    if (/^DISC (\d+)\s+(\d+)\s+$match_val(?:\s+DISC\s+(\d+))?\s+$match_val(?:\s+$match_val)?/) { 
		#print "1($1) 2($2) 3($3) 4($4) 5($5) 6($6) 7($7) 8($8) 8($9)\n";
		$config->{disc}[$1]{size} = $2;
		my $disc = $config->{disc}[$1];
		$disc->{serial} = substr "$3$4", 0, 128;
		$disc->{name} = $5;
		$disc->{longname} = "$6$7";
		$disc->{appname} = substr("$6$7", 0, 128);
		$disc->{label} = substr(("$6$7" ? "$8$9" : "$6$7"), 0, 32);
		$cd = $1;
		$type = 2;
		$fn = 0;
		$4 > $discMax and $discMax = $4;
		log_("DISC $1 $2 $3$4 $5 $6$7 $8$9\n", $config->{verbose}, $log)
	    } else {
		$nk = 1;
		$type = 0;
		log_("WARNING: DISC syntax error ($_)\n", $config->{verbose}, $log);
		log_("         DISC <cd number> <cd size> <cd serial name> DISC <real cd number> <disc name>\n", $config->{verbose}, $log)
	    }
	} elsif (/^END/) {
	    last	
	} else {
	    my @args;
	    while (s/$match_val2//) { my $a = $1; $a =~ s/"//g; push @args, $a }
	    my $prog = shift @args;
	    log_("config: function $prog(" . join(' | ',@args) . ")\n", $config->{verbose}, $log,4);
	    $type == 1 and do {
		if ($prog ne 'rpmlist') {
		    push @{$config->{list}[$cd]{packages}}, { rpm => [ $prog ] , srpm => \@args } 
		} else {
		    push @todo, [ $prog, \@args, $cd, $fn ];
		    $fn++;
		}
		next
	    };
	    $type == 2 and do {
		push @todo, [$prog, \@args, $cd, $fn];
		$fn++;
		next
	    }
	}
    }
    $config->{configfile} = $file;
    $config->{discMax} = $discMax;
    foreach (@todo) {
	my ($prog, $args, $cd, $fn) = @$_;
	if ($functions->{$prog}) {
	    log_("FUNCTION $prog (@$args)\n", $config->{verbose}, $log,5);
	    my $todo = parseCommandLine($prog, $args, $functions->{$prog});
	    @$args and usage($prog, $functions->{$prog}, "disc $cd, function $fn, @$args, too many arguments");
	    foreach (@$todo) {
		log_("config: todo $_->[2]\n", $config->{verbose}, $log, 4);
		if (!&{$_->[0]}($cd, $fn, @{$_->[1]})) { log_("ERROR: $_->[2]\n", $config->{verbose}, $log); $nk = 1 }
	    }
	} else {
	    usage($prog, $mkcd->{config}, "disc $cd, function $fn, '$prog' command does not exist");
	}
    }
    $nk and return 0;
    #printTable($config);
    1
}

sub compute_files_md5 {
    my ($md5file, $files) = @_;
    open my $MD5, ">$md5file";
    my $text;
    foreach (@$files) {
	my $md5 = new Digest::MD5;
	open my $F, $_ or die "FATAL: Could not open $_\n";
	$md5->addfile($F);
	my $digest = $md5->hexdigest;
	$text .= "$digest  $1\n" if m,([^/]+)$,
    }
    print $MD5 $text;
    close $MD5
}

sub compute_md5 {
    my ($to_check, $ignore) = @_;
    my @files;
    md5_add_tree($to_check, \@files, $ignore);
    my $md5 = new Digest::MD5;
    foreach (sort { $a->[0] cmp $b->[0] } @files) {
	my $f = $_->[1];
	open my $A, $f;
	$md5->addfile($A);
	#my $tmpmd5 = new Digest::MD5;
	#local *A, open A, $f;
	#$tmpmd5->addfile(*A);
	#print "MD5: $_->[0] (", $tmpmd5->hexdigest() ,")\n";
    }
    my $digest = $md5->hexdigest;
    # print "IGNORE " , join " ",keys %$ignore ,"\n";
    return $digest
}

sub md5_add_tree {
    my ($to_check, $files, $ignore) = @_;
    foreach (@$to_check) {
	my ($dest, $f) = @$_;
	$f =~ m|/?\.{1,2}$| and next;
	$f =~ /~$/ and next;
	$f =~ s|//+|/|g;
	$dest =~ s|//+|/|g;
	$ignore->{$dest} and next;
	if (-d $f) {
	    md5_add_tree([ map { [ "$dest/$_", "$f/$_" ] } all $f ], $files, $ignore)
	} else {
	    push @$files, [ $dest, $f ]
	}
    }
}

sub log_ {
    my ($msg, $verbose, $log, $level) = @_;
    return if $level > $verbose;
    my $LOG;
    if (!$log) { open $LOG, ">&STDERR" } else { $LOG = $log }
    my $leak_search;
    if ($level <= -1 ){
	$leak_search = "[" . (split ' ', cat_("/proc/$$/stat"))[22]/1024 . "] ";
    }
    print $LOG "$leak_search$msg";
}

# TODO must add some check of maximum authorized size
sub include_md5 {
    my ($iso, $write, $verbose) = @_;
    my $ISO; 
    if ($write) {
	open $ISO, "+<$iso" or return "ERROR include_md5: unable to open $iso ($!)\n";	
    } else {
	open $ISO, $iso or return "ERROR include_md5: unable to open $iso ($!)\n";	
    }
    binmode $ISO;
    my $offset = 16*2048;
    # blank header
    seek $ISO, $offset, 0;
    my ($buf, $msg);
    while (1) {
	read $ISO,$buf,2048;
	my $c = ord $buf;
	last if $c == 1;
	return "ERROR include_md5: could not find primary volume descriptor\n" if $c == 255;
	$offset += 2048
    }
    my $size = ((ord substr $buf, $SIZE_OFFSET, 1) * 0x1000000 + 
                (ord substr $buf, $SIZE_OFFSET + 1, 1) * 0x10000 + 
		(ord substr $buf, $SIZE_OFFSET + 2, 1) * 0x100 + 
		(ord substr $buf, $SIZE_OFFSET + 3, 1)) * 2048;
    my $volume = substr $buf, 30, 40;
    $volume =~ s/^\s*(\S.*\S)\s*$/$1/;
    my $id = substr $buf, 180, 20;
    $msg = "include_md5: volume name $volume volume id: $id iso size $size\n";
    seek $ISO, $offset + $INFO_OFFSET, 0;
    read $ISO, $buf,512;
    my ($md5sum) = $buf =~ /.md5 = (\S+)/;
    $msg .= "include_md5: previous data $buf\n";
    seek $ISO, 0, 0;
    my $md5 = new Digest::MD5;
    my $read = read $ISO, $buf, $offset + $INFO_OFFSET;
    $md5->add($buf);
    seek $ISO, 512, 1;
    $read += 512;
    $|=1;
    my $val = int $size/2048/100;
    $verbose and print "\rReading: 0 %";
    my ($i, $j);
    # skip last $SKIP bytes that sometimes are not correctly burned by some drives
    my $n = 1;
    while ($n && $read < $size - $SKIP * 2048) {
	$n = read $ISO, $buf,2048;
	print "\rReading: ", $j++, " %" if ($verbose && !($i++ % $val));
	$md5->add($buf);
	$read += $n;
    }
    print "\n";
    my $digest = $md5->hexdigest;
    $msg .= "include_md5: computed md5 $digest\n";
    my $res = $md5sum eq $digest;
    if ($md5sum) {
	$msg .= "include_md5: previous md5 $md5sum\ninclude_md5: md5sum check ";
	$msg .= $res ? "OK\n" : "FAILED\n"
    }
    print $msg if $verbose;
    $write or return $res;
    seek $ISO, $offset + $INFO_OFFSET, 0;
    my $str = substr "$volume.md5 = $digest", 0, 512;
    my $l = length $str;
    print $ISO ($l > 512 ? substr $str, -1, 512 : $str . ' ' x (512 - $l));
    close $ISO
}

sub convert_size {
    my ($size, $default, $LOG) = @_;
    if ($size =~ /[\d.]+g$/i) {
	$size = $size * $GB;
    } elsif ($size =~ /[\d+.]+m$/i) {
	$size = $size * $MB;
    } elsif ($size =~ /[\d+.]+k$/i) {
	$size = $size * $KB;
    } elsif ($size !~ /[\d+.]+$/i) {
	log_("ERROR disc: $size is invalid, using default ($default)\n",1,$LOG);
	$size = $default;
    }                    
   $size 
}

sub fix_dir {
    chomp(my $pwd = `pwd`);
    return map { m,^/, or $_ = "$pwd/$_"; $_ } @_
}

sub find_list {
    my ($config, $group, $r, $list, $notdone) = @_;
    my $l;
    my @all;
    foreach (keys %{$group->{size}{$r}}) {
	#log_("find_list: for $r trying list $_ (listmatrix $l - $_ -> $group->{listmatrix}{rpm}{$l}{$_} listmatrix $list - $_ -> $group->{listmatrix}{rpm}{$list}{$_})\n",$config->{verbose}, $config->{LOG}, 7);
	if (($l && $group->{listmatrix}{rpm}{$l}{$_}
		||
		(!$l && ($group->{listmatrix}{rpm}{$list}{$_} || !$list)))
	    && ($notdone && !$config->{list}[$_]{done} || !$notdone)) {
	    $l = $_ ;
	    unshift @all, $_
	} elsif ($group->{listmatrix}{rpm}{$list}{$_}) {
	    push @all, $_
	}
    }
    return $l, \@all
}

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
#
# 2002 03 17
# add serial name instead of cdnumber when name is not know
#
# 2002 05 07
# add check_discs, compute_md5, write_graft, md5_add_tree
#
# 2002 05 22
# fix a pb in md5 
#
# 2002 05 25
# add log function
#
# 2002 06 05
# fix md5 for isolinux
# 
# 2002 08 12
# fix/change cleanrpmsrate
#
# 2002 09 04
# do not open for writing iso file in include_md5 if not in write mode
#
# 2002 09 25
# add completion feedback to include_md5
#
# 2004 05 28
# move find_list to tools as it is used in both Build and List