#!/usr/bin/perl # $Id$ #- Copyright (C) 2002, 2003, 2004, 2005 Mandriva #- #- 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; use urpm; use urpm::args; use urpm::msg; sub usage { print N("urpmf version %s Copyright (C) 2002-2005 Mandriva. This is free software and may be redistributed under the terms of the GNU GPL. usage: ", $urpm::VERSION) . N(" --help - print this help message ") . N(" --all - print all tags ") . N(" --arch - print architecture ") . N(" --buildhost - print build host ") . N(" --buildtime - print build time ") . N(" --conffiles - print configuration files ") . N(" --conflicts - print conflict tags ") . N(" --distribution - print distribution ") . N(" --description - print package description ") . N(" --env - use specific environment (typically a bug report) ") . N(" --epoch - print epoch ") . N(" --excludemedia - do not use the given media, separated by comma ") . N(" --files - print the package's files ") . N(" --group - print group ") . N(" --literal - don't match patterns, but use argument as a literal string ") . N(" --media - use only the given media, separated by comma ") . N(" --name - print only package names ") . N(" --obsoletes - print obsoletes tags ") . N(" --packager - print packager ") . N(" --provides - print provides tags ") . N(" --requires - print requires tags ") . N(" --size - print installed size ") . N(" --sortmedia - sort media according to substrings separated by comma ") . N(" --sourcerpm - print source rpm name ") . N(" --summary - print summary ") . N(" --synthesis - use the synthesis given instead of urpmi db ") . N(" --uniq - do not print identical lines ") . N(" --update - use only update media ") . N(" --url - print url ") . N(" --vendor - print vendor ") . N(" --verbose - verbose mode ") . N(" -m - print the media in which the package was found ") . N(" -i - ignore case distinctions in every pattern ") . N(" -f - print version, release and arch with name ") . N(" -e - include perl code directly as perl -e ") . N(" -a - binary AND operator, true if both expression are true ") . N(" -o - binary OR operator, true if one expression is true ") . N(" ! - unary NOT, true if expression is false ") . N(" ( - left parenthesis to open group expression ") . N(" ) - right parenthesis to close group expression "); exit(0); } #- default options. our $update = 0; our $media = ''; our $excludemedia = ''; our $sortmedia = ''; our $synthesis = ''; our $verbose = 0; our $uniq = ''; our $pattern = ''; # regexp match flags ("i" or "") our $full = ''; # -f : print rpm fullname instead of rpm name our $literal = 0; # should we quotemeta the pattern our $qf = '%name'; our $env; our (%params, %uniq); #- parse arguments list. our $expr; urpm::args::parse_cmdline(); if ($full) { $qf =~ s/%name\b/%fullname/ } my $urpm = new urpm; $verbose or $urpm->{log} = sub {}; if ($qf eq '%name') { #- nothing on the command-line : default is to search on file names $qf = '%name:%files'; $params{files} = 1; } #- build the callback matching the expression. #- XXX it would be nice to use "my $_" in this callback. my $callback = qq; my $sprintfargs = ''; while ($callback =~ /%[-\d]*(\w+)/g) { my $tag = $1; if ($tag eq 'media') { $sprintfargs .= ', $urpm::currentmedia->{name}'; } elsif ($tag eq 'fullname') { $sprintfargs .= ', scalar($pkg->fullname)'; } else { $sprintfargs .= ', $pkg->' . $tag; } } $callback =~ s/%([-\d]*)(\w+)/%${1}s/g; $uniq and $uniq = "\n" . ' $uniq{$_} and return 1; $uniq{$_} = 1;'; $callback .= qq<$sprintfargs); $expr or return 1;$uniq print; 1; }>; $urpm->{error}("qf:[$qf]\ncallback:\n$callback") if our $debug; $callback = eval $callback; if ($@) { $debug and warn "Internal error: $@\n"; usage; } if ($env) { print STDERR N("using specific environment on %s\n", $env); #- setting new environment. $urpm->{config} = "$env/urpmi.cfg"; $urpm->{skiplist} = "$env/skip.list"; $urpm->{instlist} = "$env/inst.list"; $urpm->{statedir} = $env; } { #- lock to avoid concurrent media updates, #- but don't die if it doesn't work local $urpm->{fatal} = sub { printf STDERR "%s\n", $_[0] }; $urpm->shlock_urpmi_db; } my $use_hdlist = scalar grep { $params{$_} } qw( buildhost buildtime conf_files description distribution files packager sourcerpm url vendor ); $urpm->configure( nocheck_access => 1, noskipping => 1, media => $media, excludemedia => $excludemedia, sortmedia => $sortmedia, synthesis => $synthesis, update => $update, callback => $callback, call_back_only_once => 1, hdlist => $use_hdlist, ); $urpm->unlock_urpmi_db; if ($use_hdlist) { # @hdmedia is the list of all media searched that use hdlists my @hdmedia = grep { !$_->{synthesis} && !$_->{removable} && !$_->{ignore}; } @{ $urpm->{media} }; if (!@hdmedia) { print N("Note: since no media searched uses hdlists, urpmf was unable to return any result\n"); print N("You may want to use --name to search for package names.\n") if !$params{filename}; } }