#!/usr/bin/perl # $Id$ #- Copyright (C) 2002, 2003, 2004, 2005 MandrakeSoft SA #- Copyright (C) 2005, 2006 Mandriva SA #- #- 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; use urpm::media; sub usage() { print N("urpmf version %s Copyright (C) 2002-2006 Mandriva. This is free software and may be redistributed under the terms of the GNU GPL. usage: urpmf [options] pattern-expression ", $urpm::VERSION) . N(" --help - print this help message. ") . N(" --version - print this tool's version number. ") . N(" --env - use specific environment (typically a bug report). ") . N(" --excludemedia - do not use the given media, separated by comma. ") . N(" --literal, -l - don't match patterns, use argument as a literal string. ") . N(" --urpmi-root - use another root for urpmi db & rpm installation. ") . N(" --media - use only the given media, separated by comma. ") . N(" --sortmedia - sort media according to substrings separated by comma. ") . N(" --use-distrib - use the given path to access media ") . N(" --synthesis - use the given synthesis instead of urpmi db. ") . N(" --uniq - do not print identical lines twice. ") . N(" --update - use only update media. ") . N(" --verbose - verbose mode. ") . N(" -i - ignore case distinctions in patterns. ") . N(" -I - honor case distinctions in patterns (default). ") . N(" -F<str> - change field separator (defaults to ':'). ") . N("Pattern expressions: ") . N(" text - any text is parsed as a regexp, unless -l is used. ") . N(" -e - include perl code directly as perl -e. ") . N(" -a - binary AND operator. ") . N(" -o - binary OR operator. ") . N(" ! - unary NOT. ") . N(" ( ) - left and right parentheses. ") . N("List of tags: ") . N(" --qf - specify a printf-like output format ") . N(" example: '%%name:%%files' ") . N(" --arch - architecture ") . N(" --buildhost - build host ") . N(" --buildtime - build time ") . N(" --conffiles - configuration files ") . N(" --conflicts - conflict tags ") . N(" --description - package description ") . N(" --distribution - distribution ") . N(" --epoch - epoch ") . N(" --filename - filename of the package ") . N(" --files - list of files contained in the package ") . N(" --group - group ") . N(" --license - license ") . N(" --name - package name ") . N(" --obsoletes - obsoletes tags ") . N(" --packager - packager ") . N(" --provides - provides tags ") . N(" --requires - requires tags ") . N(" --size - installed size ") . N(" --sourcerpm - source rpm name ") . N(" --suggests - suggests tags ") . N(" --summary - summary ") . N(" --url - url ") . N(" --vendor - vendor ") . N(" -m - the media in which the package was found ") . N(" -f - print version, release and arch with name. "); exit(0); } #- default options. our $env; # bug report directory our $excludemedia = ''; our $full = ''; # -f : print rpm fullname instead of rpm name our $literal = 0; # should we quotemeta the pattern our $media = ''; our $pattern = ''; # regexp match flags ("i" or "") our $qf = '%default'; # format string our $separator = ':'; # default field separator our $sortmedia = ''; our $synthesis = ''; our $uniq = ''; # --uniq our $update = 0; # --update #- globals used in callback our $expr; # regexp to match against our %uniq; #- parse arguments list. my $urpm = new urpm; urpm::args::parse_cmdline(urpm => $urpm) or exit(1); defined $expr or usage(); if ($qf eq '%default') { #- nothing on the command-line : default is to search on file names $qf = '%name' . $separator . '%files'; } else { #- else default to a leading %name $qf =~ s/%default\b/%name/; } #- replace first %name by %fullname if -f was specified if ($full) { $qf =~ s/%name\b/%fullname/ } #- we really don't want logs on stdout, and remove verbose if not asked. $urpm->{info} = sub { print STDERR "$_[0]\n" }; $urpm->{log} = sub { print STDERR "$_[0]\n" } if $options{verbose} > 0; my $multitag = ''; my %multitags = map { $_ => 1 } qw(conffiles conflicts files obsoletes provides requires suggests); my %usedtags; (my $proto = $qf) =~ s/%([-\d]*)(\w+)/%${1}s/g; my $sprintfargs = join(', ', map { $usedtags{$_} = 1; if ($_ eq 'media') { '$urpm::media::currentmedia->{name}'; } elsif ($_ eq 'fullname') { 'scalar($pkg->fullname)'; } elsif ($_ eq 'description') { 'do { my $d = $pkg->description; $d =~ s/^/\t/mg; "\n$d" }'; } elsif ($multitags{$_}) { $multitag and $urpm->{fatal}->(1, N("Incorrect format: you may use only one multi-valued tag")); $multitag = $_; "'%s'"; } else { '$pkg->' . $_; } } $qf =~ /%[-\d]*(\w+)/g); my ($proto_cooked, $sprintfargs_cooked); if ($multitag) { ($proto_cooked, $sprintfargs_cooked) = ($proto, $sprintfargs); ($proto, $sprintfargs) = ('$proto_cooked', '$mt'); } my $next_st = $multitag ? 'next' : 'return 1'; my @inner = ( "my \$s = sprintf(qq{$proto}, $sprintfargs);", "\$s =~ $expr or $next_st;", $uniq ? ('$uniq{$s} and ' . $next_st . ';', '$uniq{$s} = 1;') : (), 'print $s, "\n";', ); if ($multitag) { @inner = ( "my \$proto_cooked = sprintf(qq{$proto_cooked}, $sprintfargs_cooked);", "foreach my \$mt (\$pkg->$multitag) {", (map { " $_" } @inner), "}", ); } #- build the callback matching the expression. my $callback = join("\n", "sub {", (map { " $_" } 'my ($urpm, $pkg) = @_;', @inner, '0;'), "}"); $urpm->{debug}("qf:[$qf]\ncallback:\n$callback") if $urpm->{debug}; $callback = eval $callback; if ($@) { warn "Internal error: $@\n"; exit(1); } if ($env) { print 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; } my $_lock = urpm::lock::urpmi_db($urpm, '', nofatal => 1, wait => $options{wait_lock}); my $need_hdlist = grep { $usedtags{$_} } qw( buildhost buildtime conf_files description distribution files license packager sourcerpm url vendor ); urpm::media::configure($urpm, nocheck_access => 1, no_skiplist => 1, no_second_pass => 1, media => $media, excludemedia => $excludemedia, sortmedia => $sortmedia, synthesis => $synthesis, usedistrib => $urpm::args::options{usedistrib}, update => $update, callback => $callback, need_hdlist => $need_hdlist, ); if ($need_hdlist) { my @hdlist_media = grep { !$_->{ignore} && -e urpm::media::any_hdlist($urpm, $_) } @{$urpm->{media}}; if (!@hdlist_media) { 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 !$usedtags{name}; } }