#!/usr/bin/perl #- Copyright (C) 2002 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. #use strict qw(subs vars refs); use urpm; #- get I18N translation method. import urpm _; sub usage { print STDERR _("urpmf version %s Copyright (C) 2002 MandrakeSoft. This is free software and may be redistributed under the terms of the GNU GPL. usage: ", $urpm::VERSION) . _(" --help - print this help message. ") . _(" --update - use only update media. ") . _(" --media - use only the given media, separated by comma. ") . _(" --synthesis - use the synthesis given instead of urpmi db. ") . _(" --verbose - verbose mode. ") . _(" --quiet - do not print tag name (default if no tag given on command line, incompatible with interactive mode). ") . _(" --all - print all tags. ") . _(" --name - print tag name: rpm filename (assumed if no tag given on command line but without package name). ") . _(" --group - print tag group: group. ") . _(" --size - print tag size: size. ") . _(" --epoch - print tag epoch: epoch. ") . _(" --summary - print tag summary: summary. ") . _(" --description - print tag description: description. ") . _(" --provides - print tag provides: all provides (multiple lines). ") . _(" --requires - print tag requires: all requires (multiple lines). ") . _(" --files - print tag files: all files (multiple lines). ") . _(" --conflicts - print tag conflicts: all conflicts (multiple lines). ") . _(" --obsoletes - print tag obsoletes: all obsoletes (multiple lines). ") . _(" -i - ignore case distinctions in every pattern. ") . _(" -f - print version, release and arch with name. ") . _(" -e - include perl code directly as perl -e. ") . _(" -a - binary AND operator, true if both expression are true. ") . _(" -o - binary OR operator, true if one expression is true. ") . _(" ! - unary NOT, true if expression is false. ") . _(" ( - left parenthesis to open group expression. ") . _(" ) - right parenthesis to close group expression. "); exit(0); } #- default options. my $update = 0; my $media = ''; my $synthesis = ''; my $verbose = 0; my $quiet = undef; my $pattern = ''; my $full = ''; my %params; #- parse arguments list. my $expr; my @nextargv; while (defined($_ = shift @ARGV)) { /^--help$/ and do { usage; next }; /^--no-locales$/ and do { undef *_; undef *urpm::_; *_ = *urpm::_ = sub { sprintf(shift @_, @_) }; next }; /^--update$/ and do { $update = 1; next }; /^--media$/ and do { push @nextargv, \$media; next }; /^--mediums$/ and do { push @nextargv, \$media; next }; /^--synthesis$/ and do { push @nextargv, \$synthesis; next }; /^--verbose$/ and do { $verbose = 1; next }; /^--quiet$/ and do { $quiet = 1; next }; /^--all$/ and do { $params{$_} = 1 foreach qw(group size summary description provides requires files conflicts obsoletes); next }; /^--(group|size|epoch|summary|description|provides|requires|files|conflicts|obsoletes)$/ and do { $params{$1} = 1; next }; /^-i$/ and do { $pattern = 'i'; next }; /^-f$/ and do { $full = 'full'; next }; /^-e$/ and do { $expr .= '('.$_.')'; next }; /^-a$/ and do { $expr .= ' && '; next }; /^-o$/ and do { $expr .= ' || '; next }; /^[!\(\)]$/ and do { $expr .= $_; next }; #- assume a regex directly unless a ++ is inside the string, someother to use ? /\+\+/ and $_ = quotemeta $_; $expr .= 'm{'.$_.'}'.$pattern; } my $urpm = new urpm; $verbose or $urpm->{log} = sub {}; for (scalar(keys %params)) { $_ eq 0 and do { defined $quiet or $quiet = 1; $params{files} = 1 }; $_ eq 1 and do { defined $quiet or $quiet = 1 }; $_ > 1 and do { defined $quiet or $quiet = 0 }; } #- build callback according expression. my $callback = 'sub { my ($urpm, $pkg) = @_; '; #- it is a good start for a sub, no ;-) foreach (qw(group size epoch summary description provides requires files conflicts obsoletes)) { $params{$_} and $callback .= 'foreach my $e ($pkg->'.$_.') { local $_ = $pkg->'.$full.'name."'.(!$quiet && ":$_").':$e"; '.$expr.' or next; print "$_\n" }'; } $callback .= ' 1; }'; $urpm->{log}(_("callback is :\n%s\n", $callback)); $callback = eval $callback; $@ and usage; $urpm->configure(nocheck_access => 1, media => $media, synthesis => $synthesis, update => $update, callback => $callback, hdlist => $params{summary} || $params{description} || $params{files}, ); #- that'all! all has been done by callback above.