#!/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; use urpm; # get I18N translation method. import urpm _; #- default options. my $query = { use_provides => 1, }; 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 - 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). ") . _(" --list - list package available. ") . _(" --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 }; /^--list$/ and do { $query->{list} = 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}, ); my $state = { requested => {} }; #- if list has been activated, select all... if ($query->{list}) { @{$state->{selected}}{0 .. $#{$urpm->{depslist}}} = (); } else { my ($start, $end) = $urpm->register_rpms(@files); #- select individual files. defined $start && defined $end and @{$state->{requested}}{($start .. $end)} = (); #- 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. if (@names) { $urpm->search_packages($state->{requested}, [ @names ], use_provides => $query->{use_provides}, fuzzy => $query->{fuzzy}) or $query->{force} or exit 1; } if (@src_names) { $urpm->search_packages($state->{requested}, [ @src_names ], use_provides => $query->{use_provides}, fuzzy => $query->{fuzzy}, src => 1) or $query->{force} or exit 1; } #- keep track of choices, do no propagate but mark them in selected. my $stop_on_choices = sub { my ($urpm, $db, $state, $choices) = @_; $state->{selected}{join '|', sort { $a <=> $b } map { $_ ? ($_->id) : () } @$choices} = 0; }; #- 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->{upgrade}) { my $db = URPM::DB::open($query->{root}); my $sig_handler = sub { undef $db; exit 3 }; local $SIG{INT} = $sig_handler; local $SIG{QUIT} = $sig_handler; require URPM::Resolve; #- auto select package for upgrading the distribution. if ($query->{auto_select}) { my (%to_remove, %keep_files); $urpm->resolve_packages_to_upgrade($db, $state, requested => 0); if (%{$state->{ask_remove} || {}} || %{$state->{ask_unselect} || {}}) { $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. if ($query->{upgrade}) { $urpm->resolve_requested($db, $state, callback_choices => $stop_on_choices); #- dependancies are not asked, just clean selected part with added value (undef). $query->{deps} or delete @{$state->{selected}}{grep { exists $state->{selected}{$_} && ! defined $state->{selected}{$_}} keys %{$state->{selected}}}; } } elsif ($query->{deps}) { #- only deps required. my $empty_db = new URPM; #- URPM has same methods as URPM::DB and empty URPM will be seen as empty URPM::DB. require URPM::Resolve; $urpm->resolve_requested($empty_db, $state, callback_choices => $stop_on_choices); #$urpm->filter_packages_to_upgrade($db, $state->{requested}, undef, keep_alldeps => 1); } else { $state->{selected} = $state->{requested}; } #- get out of package that should not be upgraded. $urpm->deselect_unwanted_packages($state->{selected}); if ($query->{headers} || $query->{sources}) { my ($local_sources, $list) = $urpm->get_source_packages($state->{selected}); 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 $pkg = $urpm->{depslist}[$id]; my $str = ''; $query->{group} and $str .= $pkg->group . '/'; $str .= $pkg->name; $query->{version} and $str .= '-' . $pkg->version; $query->{release} and $str .= '-' . $pkg->release; $query->{arch} and $str .= '.' . $pkg->arch; $str; }; my %hack_only_one; foreach my $id ($state->{selected} ? keys %{$state->{selected}} : keys %{$state->{requested}}) { my $class = $state->{selected}{$id} || $state->{requested}{$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 { print join('|', map { $query_sub->($_) } split '\|', $id), "\n"; } }