package MGATools::rpmsrate;

use strict;
use MDK::Common;

require Exporter;
use URPM;
our @ISA = qw(Exporter);
our @EXPORT = qw(cleanrpmsrate);

=head1 NAME

Mageia rpmsrate tools

=head1 SYNOPSYS

    require MGATools::rpmsrate;

=head1 DESCRIPTION

<MGATools::rpmsrate> includes Mageia rpmsrate tools.

=head1 COPYRIGHT

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

# must preread to get locale guessed packages
sub preread_rpmsrate {
    my ($rpmsrate) = @_;
    my (@rpmsrate, %potloc);
    foreach (cat_or_die($rpmsrate)) {
	chomp;
	s/#.*//;
	#s/\s*$//;
	if (/^(\s*)$/) {
	    push @rpmsrate, [ '', 0, '', [] ];
	    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*)(.*)$/;
	# postfix is just used not to break the diff when checking if the result is correct
	my ($postfix) = $data =~ /(\s*)$/;
	my @data = ([ $data =~ /(?:^|\s)(\S+)-(?:\S+)\s+\1-(?:\S+)(?:\s|$)/g ],
                    [ split ' ', $data ]);
	$potloc{$_} = [] foreach  @{$data[0]};
	push @rpmsrate, [ $indent,$r, $flags, $data[1], $postfix ];
    }
    (\@rpmsrate, \%potloc);
}

sub lookup_pkg {
    my ($fullpath, $urpm) = @_;
    
    my $id = $urpm->parse_rpm($fullpath);
    return $urpm->{depslist}[$id];
}

sub check_if_expandable {
    my ($raw, $fullpath, $potloc, $locale, $localized_pkg, $urpm) = @_;
    my ($pg, $loc) = $raw =~ /^(.*)-([^-+]+)$/;
    return if !$pg || !$loc;
    return if !$potloc->{$pg};

    my $pkg = lookup_pkg($fullpath, $urpm);

    # still nothing? bailout:
    if (!$pkg) {
        print "ERROR cleanrpmsrate: parse_rpm $fullpath ($raw) 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-[a-zA-Z_]*/ } $pkg->requires) {
        push @{$locale->{$pg}}, $loc;
        $localized_pkg->{"$pg-$loc"} = 1;
    }
}

# function copied from Mkcd::Tools
sub cleanrpmsrate {
    my ($rpmsrate_file, $output, $reprpms) = @_;

    my ($rpmsrate, $potloc) = preread_rpmsrate($rpmsrate_file);

    my (%rpms, $text, %rate, %section, %keyword, %locale, %localized_pkg);
    # LIVE & INSTALL keyswords are special:
    my @plain_flags = qw(INSTALL LIVE);
    my $kernel_like = "((?:(?:NVIDIA_)?kernel|NVIDIA_nforce|cm2020).*)";
    my $dkms_like = '(.*)([-_])kernel-([0-9]+(?:\.[0-9]+){2,3}-\w+-[0-9]+(?:.[^.]+){0,2}\.?mga\d+)(.*)';
    my $rpmsrate_dkms_like = "(.*[-_]kernel)(.*)";
    my $urpm = URPM->new;

    foreach my $dir (keys %$reprpms) {
	foreach (@{$reprpms->{$dir}}) {
	    my $rpm = "$_.rpm";
	    s/-[^-]+-[^-]+\.[^.]+$// or next;

	    if (/(.*?)([_-]*[\d._]+)(-.*)?-devel$/ || /^$kernel_like(-[^.]+(?:\.[^.]+){3,6}\.?mga\d+)$/) { 
		if (!$rpms{"$1$3"} || URPM::ranges_overlap("== $2", "> $rpms{'$1$3'}")) {
		    $rpms{"$1$3"} = [ $2, $1, $3 ];
		}
		if (/^$kernel_like-(\d+\.\d+)(.*)/) {
		    $rpms{"$1-$2"} = [ $3, "$1-$2" ];
		}
	    } elsif (/^$dkms_like$/) {
		my $vname = "$1$2kernel$4";
		if (!$rpms{$vname}) {
		    $rpms{$vname} = [ $3, $vname ];
		} elsif (URPM::ranges_overlap("== $3", "> $rpms{$vname}[0]")) {
		    $rpms{$vname} = [ $3, $vname ];
		}
	    } else {
                check_if_expandable($_, "$dir/$rpm", $potloc, \%locale, \%localized_pkg, $urpm);
	    }
	}
    }
    undef $urpm;

    my (%done, @flags, @tree_rate, $prev_level);
    foreach (@$rpmsrate) {
	if (!$_->[0]) {
	    $text .= "$_->[2]$_->[4]\n";
	    @flags = $_->[2] if $_->[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);

	if (!@$data) {
	    $text .= "$indent$r$flags$postfix\n";
	    next;
	}

	my @k;
	my $flat_path = join ' ', @flags;
	foreach (@$data) {
	    my $c = $_;
	    next if ref $done{$_} && any { $flat_path eq $_ } @{$done{$_}};

            my $is_plain_flag = member($flags[0], @plain_flags);

	    die "FATAL: too complicated flags for duplicate entry $c ($flat_path and " . join ',', @{$done{$_}} 
	         if !$is_plain_flag && @flags > 1 && any { 
			 my ($f) = $flat_path =~ /^[^ ]+ (.*)/;
			 !/^[^ ]+ (.*)/ || $1 ne $f;
		 } @{$done{$_}};

	    my ($name) = /(.*)-[^-]+/;
	    my ($e, $do);

            if (!$is_plain_flag) {
                my ($a, $b);
                if ((s/(-devel)// ? ($b = "-devel") : /^$kernel_like/) &&
                      ($rpms{$_} || (defined $rpms{"lib$_"} and $a = "lib") || (defined $rpms{"lib64$_"} and $a = "lib64")
                         || (s/^lib(.*?)[_-]*[\d._]*(-.*)?$/$1$2/g && defined $rpms{"lib64$_"} and $a = 'lib64'))) {
                    warn ">> looking at $c\n";
                    $e = $rpms{"$a$_"}[1] . $rpms{"$a$_"}[0] . $rpms{"$a$_"}[2] . $b;
                    $do = 1;
                } elsif (/^$rpmsrate_dkms_like$/ && $rpms{"$1$2"}) {
                    $e = "$1-" . $rpms{"$1$2"}[0] . $2;
                    $do = 1;
                }

            }

	    if ($do) {
		$keyword{$c} = $e;
	       	if (!ref $done{$e} || $is_plain_flag && !(any { $flat_path eq $_ } @{$done{$e}}) || $flat_path =~ /DRIVER|HW/) {
		    push @{$done{$e}}, $flat_path;
		    push @k, $e;
		}
	    }

	    # process localized packages (eg: man-pages-XX, hunspell-XX, firefox-XX, ...)
	    if ($locale{$name} && $localized_pkg{$c}) {
		foreach (sort @{$locale{$name}}) {
		    next if member($flat_path, @{$done{"$name-$_"}});
		    push @{$done{"$name-$_"}}, $flat_path; 
		    push @k , "$name-$_";
		}
		next;
	    }
	    push @k, $c;
	    push @{$done{$c}}, $flat_path;
	} 

	$text .= "$indent$r$flags@k$postfix\n" if @k;
	@rate{@k} = ($rate) x @k;
	my $path;
	foreach (@flags) {
	    $path .= $path ? "/$_" : $_;
	    push @{$section{$path}}, @k;
	}
    }

    if (%rpms || $output || %locale) {
	if (%$reprpms || $output) {
	    $output ||= $rpmsrate_file;
	    if (open my $A, ">$output") {
		print $A $text;
	    } else { 
		warn "ERROR cleanrpmsrate: cannot open $rpmsrate_file for writing\n";
		print $text;
	    }
	}
    }
}

1