#!/usr/bin/perl

#- Copyright (C) 2000 MandrakeSoft (fpons@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.

#- this program is based upon urpmi.

#use strict qw(subs vars refs);
use urpm;

# get I18N translation method.
import urpm _;

#- default options.
my $query = {};

my @files;
my @names;
my @src_names;

sub usage {
    print STDERR _("urpmq version %s
Copyright (C) 2000, 2001, 2002 MandrakeSoft.
This is free software and may be redistributed under the terms of the GNU GPL.

usage:
") . _("  -h             - print this help message.
") . _("  -v             - verbose mode.
") . _("  -d             - extend query to package dependencies.
") . _("  -u             - remove package if a better version is already installed.
") . _("  -c             - choose complete method for resolving requires closure.
") . _("  -p             - allow search in provides to find package.
") . _("  -P             - do not search in provides to find package.
") . _("  -y             - impose fuzzy search (same as --fuzzy).
") . _("  -s             - next package is a source package (same as --src).
") . _("  -g             - print groups too with name.
") . _("  -r             - print version and release too with name.
") . _("  -f             - print version, release and arch with name.
") . "\n" . _("  --update       - use only update media.
") . _("  --media        - use only the media listed by comma.
") . _("  --auto-select  - automatically select packages for upgrading the system.
") . _("  --fuzzy        - impose fuzzy search (same as -y).
") . _("  --src          - next package is a source package (same as -s).
") . _("  --headers      - extract headers for package listed from urpmi db to
                   stdout (root only).
") . _("  --sources      - give all source packages before downloading (root only).
") . _("  --force        - force invocation even if some packages do not exist.
") . "\n" . _("  names or rpm files given on command line are queried.
", $urpm::VERSION);
    exit(0);
}

#- params contains informations to parse installed system.
my $urpm = new urpm;

#- parse arguments list.
my @nextargv;
for (@ARGV) {
    /^--help$/ and do { usage; next };
    /^--update$/ and do { $query->{update} = 1; next };
    /^--media$/ and do { push @nextargv, \$query->{media}; next };
    /^--mediums$/ and do { push @nextargv, \$query->{media}; next };
    /^--auto-select$/ and do { $query->{auto_select} = 1; next };
    /^--fuzzy$/ and do { $query->{fuzzy} = 1; next };
    /^--src$/ and do { $query->{src} = 1; next };
    /^--headers$/ and do { $query->{headers} = 1; next };
    /^--sources$/ and do { $query->{sources} = 1; next };
    /^--force$/ and do { $query->{force} = 1; next };
    /^--root$/ and do { push @nextargv, \$query->{root}; next };
    /^--wget$/ and do { $urpm->{sync} = \&urpm::sync_wget; next };
    /^--curl$/ and do { $urpm->{sync} = \&urpm::sync_curl; next };
    /^-(.*)$/ and do { foreach (split //, $1) {
	/[\?h]/ and do { usage; next };
	/d/ and do { $query->{deps} = 1; next };
	/u/ and do { $query->{upgrade} = 1; next };
	/m/ and do { $query->{deps} = $query->{upgrade} = 1; next };
	/M/ and do { $query->{deps} = $query->{upgrade} = 1; next };
	/c/ and do { $query->{complete} = 1; next };
	/g/ and do { $query->{group} = 1; next };
	/p/ and do { $query->{use_provides} = 1; next };
	/P/ and do { $query->{use_provides} = 0; next };
	/y/ and do { $query->{fuzzy} = 1; next };
	/s/ and do { $query->{src} = 1; next };
	/v/ and do { $query->{verbose} = 1; next };
	/r/ and do { $query->{version} = $query->{release} = 1; next };
	/f/ and do { $query->{version} = $query->{release} = $query->{arch} = 1; next };
	print STDERR _("urpmq: unknown option \"-%s\", check usage with --help\n", $1); exit(1) } next };
    @nextargv and do { my $r = shift @nextargv; $r and $$r = $_; next };
    /\.rpm$/ and do { if (-r $_) { push @files, $_; }
		      else { print STDERR _("urpmq: cannot read rpm file \"%s\"\n", $_); }
		      next };
    if ($query->{src}) {
	push @src_names, $_;
    } else {
	push @names, $_;
    }
    $query->{src} = 0; #- reset switch for next package.
}

#- remove verbose if not asked.
$query->{verbose} or $urpm->{log} = sub {};

$urpm->configure(nocheck_access => 1,
		 media => $query->{media},
		 update => $query->{update}
		 @files > 0 ? (files => [ @files ]) : (),
		);

#- search the packages according the selection given by the user,
#- basesystem is added to the list so if it need to be upgraded, all its dependency
#- will be updated too.
my %packages;
if (@names) {
    $urpm->search_packages(\%packages, [ @names ],
			   use_provides => $query->{use_provides},
			   fuzzy => $query->{fuzzy})
	or $query->{force} or exit 1;
}
if (@src_names) {
    $urpm->search_packages(\%packages, [ @src_names ],
			   use_provides => $query->{use_provides},
			   fuzzy => $query->{fuzzy},
			   src => 1)
	or $query->{force} or exit 1;
}

#- open/close of database should be moved here, in order to allow testing
#- some bogus case and check for integrity.
if ($query->{auto_select} || $query->{deps}) {
    my $db = URPM::DB::open($root);
    my $sig_handler = sub { undef $db; exit 3 };
    local $SIG{INT} = $sig_handler;
    local $SIG{QUIT} = $sig_handler;

    #- auto select package for upgrading the distribution.
    if ($query->{auto_select}) {
	my (%to_remove, %keep_files);

	$urpm->select_packages_to_upgrade($db, \%packages, \%to_remove, \%keep_files);

	if (keys(%to_remove) > 0) {
	    $urpm->{error}(_("some packages have to be removed for being upgraded, this is not supported yet\n"));
	}
    }

    #- filter to add in packages selected required packages.
    $query->{deps} and $urpm->filter_packages_to_upgrade($db, \%packages, undef, keep_alldeps => !$query->{upgrade});
}

#- get out of package that should not be upgraded.
$urpm->deselect_unwanted_packages(\%packages);

if ($query->{headers} || $query->{sources}) {
    my ($local_sources, $list) = $urpm->get_source_packages(\%packages);
    unless ($local_sources || $list) {
	$urpm->{fatal}(1, _("unable to get source packages, aborting"));
    }

    if ($query->{headers}) {
	#- now examine source package to build headers list to extract.
	values %$local_sources and system 'rpm2header', values %$local_sources;
	foreach (0..$#{$urpm->{media} || []}) {
	    my @headers = (grep { my $file = "$urpm->{cachedir}/headers/$_";
				  -s $file and system 'cat', $file;
				  ! -s $file }
			   map { /(.*)\/([^\/]*)-([^-]*)-([^-]*)\.([^\.]*)\.rpm/ and "$2-$3-$4.$5" } values %{$list->[$_]});
	    @headers > 0 or next;

	    if (-s "$urpm->{statedir}/$urpm->{media}[$_]{hdlist}") {
		require packdrake;
		my $packer = new packdrake("$urpm->{statedir}/$urpm->{media}[$_]{hdlist}");
		$packer->extract_archive(undef, @headers);
	    } else {
		#- fallback to retrieve rpm package before, so that --headers will be ok.
		my %downloads = $urpm->download_source_packages({}, $list, 'local', undef);
		print STDERR join " ", "rpm2header", values %downloads;
		system "rpm2header", values %downloads;
	    }
	}
    } else {
	print join "\n", values %$local_sources; values %$local_sources and print "\n";
	foreach (0..$#{$urpm->{media} || []}) {
	    print join "\n", values %{$list->[$_]}; values %{$list->[$_]} and print "\n";
	}
    }
    exit 0;
}

#- print sub for query.
my $query_sub = sub {
	my ($id) = @_;
	my $info = $urpm->{params}{depslist}[$id];
	my $str = '';
	$query->{group} and $str .= $info->{group} . '/';
	$str .= $info->{name};
	$query->{version} and $str .= '-' . $info->{version};
	$query->{release} and $str .= '-' . $info->{release};
	$query->{arch} and $str .= '.' . $info->{arch};
	$str;
};

my %hack_only_one;
foreach my $id (keys %packages) {
    my $class = $packages{$id};
    if (ref $class) {
	foreach my $choices (@{$class || []}) {
	    exists $hack_only_one{$choices} and next;
	    print join('|', map { $query_sub->($_) } @$choices), "\n";
	    $hack_only_one{$choices} = undef;
	}
    } else {
	exists $packages{$id} and print join('|', map { $query_sub->($_) } split '\|', $id), "\n";
    }
}