package Mkcd::Package;

our $VERSION = '1.0.0';

use File::NCopy qw(copy); 
use File::Path;       
use URPM;
use URPM::Build;
use Mkcd::Tools qw(du cleanrpmsrate printDiscsFile log_);
use strict;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(check_rpmsrate packageOutOfRpmsrate genDeps getLeaves list_hdlist getSize rpmVersionCompare mkcd_build_hdlist %ARCH get_sorted_packages);

my %ARCH;

=head1 NAME

Packages - mkcd module

=head1 SYNOPSYS

    require Mkcd::Functions;

=head1 DESCRIPTION

C<Mkcd::Functions> include the mkcd low level packages functions.

=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.

=cut

%ARCH = ( 
    x86_64 => 1,
    i586 => 1,
    noarch => 1,
    k7 => 1,
    ppc => 1,
    ia64 => 1,
    i686 => 2,
    i486 => 2,
    i386 => 3
);

sub genDeps {
    my ($top, $reps, $deps, $VERBOSE, $TMP) = @_;
    $top or print "ERROR genDeps: no top dir defined\n" and return 0;
    %$reps or return 0;
    -d $top or mkpath $top or die "FATAL genDeps: could not create $top\n";
    
    # FIXME the function parse_hdlist exist and should be used if the rpms list has not changed
    # if ($deps || ! (-f "$top/depslist.ordered" && -f "$top/hdlist.cz")) {
	my @rpms;
	my %done;
	foreach my $rep (keys %$reps) {
	    #$VERBOSE and print "genDeps: adding rep $rep\n";
	    foreach my $rpm (@{$reps->{$rep}}) {
		$done{$rpm} and next;
		push @rpms, "$rep/$rpm.rpm";
		$done{$rpm} = 1
	    }
	}
	# Need to create hdlist and synsthesis on filesystem to estimate deps files
	# size in disc->guessHdlistSize.
	return mkcd_build_hdlist(1, [ 0, { rpms => \@rpms,
		   hdlist => "$top/hdlist.cz",
		   synthesis => "$top/synthesis.hdlist.cz",
		   callback => sub {
		       my ($urpm, $id) = @_;
		       my $pkg = $urpm->{depslist}[$id];
		       my $fullname = $pkg->fullname;
		       my $filename = $pkg->filename;
		       $filename =~ s/\.rpm$//;
		       $urpm->{sourcerpm}{$fullname} = $pkg->sourcerpm;
		       $urpm->{rpm}{$fullname} = $pkg;
		       $urpm->{files}{$fullname} = [ $pkg->files ];
		       $urpm->{rpmkey}{rpm}{$fullname} = $filename;
		       $urpm->{rpmkey}{key}{$filename} = $fullname;
		       $pkg->pack_header 
		   }
	       } ], "$TMP/.mkcd_build_hdlist", "$top/depslist.ordered", "$top/provides", "$top/compss");
}

sub mkcd_build_hdlist {
    my ($num, $hdlist, $headers_dir, $depslist, $provides, $compss) = @_;
    my $urpm = new URPM;
    -d $headers_dir or mkpath $headers_dir;
    my $last;
    print "mkcd_build_hdlist: first pass\n";
    foreach (1 .. $num) {
	if ($hdlist->[$_]{done}) {
	    print "mkcd_build_hdlist: reading existing hdlist $hdlist->[$_]{hdlist} (1st pass)\n";
	    $urpm->parse_hdlist($hdlist->[$_]{hdlist});
	    $hdlist->[$_]{headers} = list_hdlist([$hdlist->[$_]{hdlist}], 0, 1, $headers_dir);
	} else {
	    $last = $_;
	    $hdlist->[$_]{headers} = 
	    [ $urpm->parse_rpms_build_headers(
		dir => $headers_dir, 
		rpms => $hdlist->[$_]{rpms}) ];
	}
    }

    print "mkcd_build_hdlist: second pass\n";
    $urpm->unresolved_provides_clean;
    foreach (1 .. $num) {
	my $e = $hdlist->[$_];
	if ($e->{done} && $_ > $last) {
	    print "mkcd_build_hdlist: reading existing hdlist $e->{hdlist} (2nd pass)\n";
	    $urpm->parse_hdlist($e->{hdlist});
	    $urpm->compute_deps;
	} else {
	    print "mkcd_build_hdlist: parse header for $e->{hdlist}\n";
	    my ($start, $end) = $urpm->parse_headers(dir => $headers_dir, headers => $e->{headers}, callback => $hdlist->[$_]{callback});
	    if (!@{$e->{headers}}) {
		print "WARNING mkcd_build_hdlist: $e->{hdlist} and $e->{synthesis} are empty (start $start end $end)\n";
		next
	    }
	    $urpm->compute_deps;
	    if (length $e->{hdlist}) {
		print "mkcd_build_hdlist: write $e->{hdlist}\n";
		$urpm->build_hdlist(start => $start, end => $end, dir => $headers_dir, hdlist => $e->{hdlist}, ratio => 9);
	    }
	    if (length $e->{synthesis}) {
		print "mkcd_build_hdlist: write $e->{synthesis}\n";
		$urpm->build_synthesis(start => $start, end => $end, synthesis => $e->{synthesis});
		print "done\n"
	    }
	}
    }
    $urpm->build_base_files(depslist => $depslist, provides => $provides, compss => $compss);

    return $urpm;
}

sub get_sorted_packages {
    my ($urpm, $hdlist, $sort, $cd_rep, $dir, $nolive, $verbose, $LOG) = @_;
    my %done_rep;
    $LOG or open $LOG, "&>STDERR";
    log_("get_sorted_packages\n", $verbose, $LOG, 2);
    my %id;
    for (my $i; $i < @{$urpm->{depslist}}; $i++) {
	$id{$urpm->{depslist}[$i]->filename} = $i
    }
    for (my $i = 1; $i < @$hdlist; $i++) {
	if (! ref $cd_rep->{$i}) {
	    log_("WARNING installation: cdrep $i is emtpy, ignoring\n", $verbose, $LOG, 5);
	    next
	}
	my ($cd, $repname) = @{$cd_rep->{$i}};
	my @chunk;
	foreach (@{$hdlist->[$i]{rpms}}) {
	    my ($rpm) = m,([^/]+)$,;
	    log_("installation: sorting rpms $rpm ($id{$rpm})\n", $verbose, $LOG, 5);
	    push @chunk, [ $id{$rpm}, $nolive ? $_ : "$dir/$repname/$rpm" ]
	}
	unshift @{$sort->{$cd}}, [ map { $_->[1] } sort { $b->[0] <=> $a->[0] } @chunk ]
    }
}

sub packageOutOfRpmsrate {
    my ($rpmsrate) = @_;
    my $rate = cleanrpmsrate($rpmsrate);
    print join("\n", sort(keys %$rate)), "\n";
    1
}

sub check_rpmsrate {
    my ($rpmsrate, @rpms) = @_;
    my %rpm_name;
    my %dir;
    foreach (@rpms) {
	if (-d $_) { 
	    opendir my $dir, $_;
	    foreach my $rpm (readdir $dir) {
	      if ($rpm =~ /((.*)-[^-]+-[^-]+\.[^.]+)\.rpm/) {
		push @{$dir{$_}}, $1;
		push @{$rpm_name{$2}}, $rpm
	      }
	    }
	    closedir $dir
	}	
    }
    my ($rate, undef, $keyword) = @{cleanrpmsrate($rpmsrate, 0, 0, \%dir)};
    foreach (keys %$rate) {
	if (!$rpm_name{$_} && !$keyword->{$_}) { print "$_\n" }
    }
    1
}

sub getLeaves {
    my ($depslist) = @_;
    open DEP, $depslist or die "Could not open $depslist\n";
    my @name;
    my %pkg;
    my $i = 0;
    foreach (<DEP>){
	chomp;
	my ($name, undef, @de) = split " ", $_;	
	($name, my $version, my $release) = $name =~ /(.*)-([^-]*)-([^-]*)/;
	if ($name){
	    foreach my $d (@de) {
		if ($d !~ s/^NOTFOUND_//) {
		    my @t = split '\|',$d ;
		    foreach my $t (@t) { if ($t !~ s/NOTFOUND_//) { $pkg{$name[$t]}++ }}
		}else { $pkg{$name[$d]}++}
	    }
	}
	$name[$i] = $name;
	$pkg{$name[$i]}++;
	$i++;
    }
    foreach (sort keys %pkg){
	print $pkg{$_} - 1, " $_\n";
    }
    1
}

sub getRpmsrate{
    print "ERROR: this function is deprecated\n";
    return 0;

    my ($rpmsrate,$reps,$tmp,$name,$VERBOSE) = @_;
    my $TMP = $tmp || $ENV{TMPDIR};
    my $tmprpmsrate = "$TMP/$name/rpmsrate";
    local *R; open R, ">$tmprpmsrate" or print "ERROR: cannot open temporary rpmsrate file $tmprpmsrate\n";
    my $rate = Mkcd::Tools::cleanrpmsrate($rpmsrate,*R,@$reps);
    close R;
    unlink "$rpmsrate" and copy "$tmprpmsrate", "$rpmsrate";
    local *R; open R, "$rpmsrate" or print "ERROR: cannot open rpmsrate file $rpmsrate\n";
    [$rate->[0],$rate->[1]];
}

sub list_hdlist {
    my ($hdlist, $verbose, $extract, $dir) = @_;
    print "list_hdlist: hdlists @$hdlist\n";
    my $package_list;
    foreach (@$hdlist){
	my $packer = new packdrake($_);
	my $count = scalar keys %{$packer->{data}};
	$verbose and print qq($count files in archive, uncompression method is "$packer->{uncompress}"\n);
	my @to_extract;
	foreach my $file (@{$packer->{files}}){
	    if (! -f "$dir/$file") {
		push @to_extract, $file
	    }
	    $file =~ /(.*-[^-]+-[^-]+\.[^.]+):(.*)/ and $file = $2;
	    push @$package_list, $file;
	}
	if ($extract) {
	    $packer->extract_archive($dir, @to_extract)
	} else {
	    packdrake::list_archive($_);
	}
	if (0) {
	    my %extract_table;
	    foreach my $file (@{$packer->{files}}) {
		push @$package_list, $file;
		if ($verbose || $extract) { 
		    my $newfile = "$dir/$file";
		    for ($packer->{data}{$file}[0]) {
			if (/l/) { 
			    $verbose and printf "l %13c %s -> %s\n", ' ', $file, $packer->{data}{$file}[1]; 
			    $extract and packdrake::symlink_ $packer->{data}{$file}[1], $newfile; 
			} elsif (/d/) { 
			    $verbose and printf "d %13c %s\n", ' ', $file;
			    $extract and $dir and packdrake::mkdir_ $newfile; 
			} elsif (/f/) { 
			    $verbose and printf "f %12d %s\n", $packer->{data}{$file}[4], $file;
			    if ($extract) { 
				$dir and packdrake::mkdir_ dirname $newfile;
				my $data = $packer->{data}{$file};
				$extract_table{$data->[1]} ||= [ $data->[2], [] ];
				push @{$extract_table{$data->[1]}[1]}, [ $newfile, $data->[3], $data->[4] ];
				$extract_table{$data->[1]}[0] == $data->[2] or die "packdrake: mismatched relocation in toc\n";
			    }
			}
		    }
		}
	    }
	}
    }
    $package_list
}

sub getSize{
    my ($group, $config, $VERBOSE) = @_;
    my $max;
    my $redeps; 
    foreach my $listnumber (keys %{$group->{list}}) {
	print "getSize list $listnumber\n";
	my $repnb;
	my $done = $config->{list}[$listnumber]{pseudo_done} || $config->{list}[$listnumber]{done};
	print "getSize: list $listnumber done or pseudodone\n" if $done;
	#$group->{nodeps}{$listnumber} and next;
	ref $group->{rep}{$listnumber} or next;
	for (my $repnb; $repnb < @{$group->{rep}{$listnumber}}; $repnb++) {
	    my $rep = $group->{rep}{$listnumber}[$repnb];
	    
	    foreach my $dir (keys %{$rep->{rpm}}){
		#$VERBOSE and print "getSize rep $dir\n";
		foreach (@{$rep->{rpm}{$dir}}){
		    my $rpm = $group->{urpm}{rpmkey}{key}{$_} or print "getSize ERROR: $_ has no key, ignored\n" and next; #return 2;
		    my $b = Mkcd::Tools::du("$dir/$_.rpm") if !$config->{list}[$listnumber]{nosize};
		    $group->{listsize}{$listnumber}{rpm} += $b;
		    if (!$done) {
			$b or print "WARNING getSize: $rpm has a zero size\n";
		    } else {
			$b = 0
		    }
		    ref $group->{size}{$rpm}{$listnumber} and print "ERROR getSize: duplicate $rpm in list $listnumber, ignoring\n" and next;
		    $group->{size}{$rpm}{$listnumber} = [$b, $dir, $repnb];
		    push @{$group->{listrpm}{$listnumber}}, $rpm;
		    $b > $max and $max = $b;
		}
	    }
	    foreach my $dir (keys %{$rep->{srpm}}){
		#$VERBOSE and print "getSize DIRECTORY $dir\n";
		foreach (@{$rep->{srpm}{$dir}}){
		    my ($srpm,$srpmname,$key);
		    if (($srpm,$srpmname) = /((.*)-[^-]*-[^-]*\.src)$/){
			$key = $srpm;
		    } else {
			($key) = /(.*)$/;
			# FIXME not tested
			my $urpm = new URPM;
			my $id = $urpm->parse_rpm("$dir/$_.rpm") or print "ERROR getSize: parse_rpm $dir/$_.rpm failed\n" and next;
			my $pkg = $urpm->{depslist}[$id];
			my $srpm = $pkg->sourcerpm or next;
			(undef, $srpmname) = $srpm =~ s/((.*)-[^-]+-[^-]+\.src)\.rpm/$1/
		    }
		    $group->{urpm}{rpmkey}{key}{$key} = $srpm; 
		    $group->{urpm}{rpmkey}{rpm}{$srpm} = $key; 
		    my $b;
		    if (!$done) { 
			$b = Mkcd::Tools::du("$dir/$_.rpm") if !$config->{list}[$listnumber]{nosize};
			$b or print "WARNING getSize: $srpm has a zero size\n";
		    }
		    ref $group->{size}{$srpm}{$listnumber} and print "ERROR getSize: duplicate $srpm in list $listnumber, ignoring\n" and next;
		    $group->{size}{$srpm}{$listnumber} = [$b,$dir,$repnb];
		    $group->{srpmname}{$srpmname} = $srpm;
		}
	    }
	}
    }
    $group->{maxsize} = $max;
    1
}

sub rpmVersionCompare{
    my ($pkg1, $pkg2) = @_;
    my ($n1,$v1,$a1) = $pkg1 =~ /^(.*)-([^-]+-[^-]+)\.([^.]+)(\.rpm)?$/;
    my ($n2,$v2,$a2) = $pkg2 =~ /^(.*)-([^-]+-[^-]+)\.([^.]+)(\.rpm)?$/;
    die "ERROR rpmVersionCompare: trying to compare version of two differently named packages ($pkg1,$pkg2)\n" if (!($n1 eq $n2)) ;
    my $ret = URPM::ranges_overlap("== $v1","> $v2");
    if ($ret){
	return $ret
    }else{
	$ret = URPM::ranges_overlap("== $v1","< $v2");
	if ($ret){
	    return -$ret
	}
	if ($ARCH{$a1} < $ARCH{$a2}){
	    return -1 
	}elsif ($ARCH{$a1} > $ARCH{$a2}){
	    return 1
	}else{
	    return 0
	}
    }
}


1

# Changelog
#
# 2002 06 01
# use perl-URPM
# add mkcd_build_hdlist function
#
# 2002 06 03
# new perl-URPM API
#
# 2004 07 05
# getSize check for list done or pseudo_done not to use the size (for the disc build function those rpm has a zero size)