1 |
#!/usr/bin/perl |
2 |
|
3 |
# $Id: urpmf 271299 2010-11-21 15:54:30Z peroyvind $ |
4 |
|
5 |
#- Copyright (C) 2002, 2003, 2004, 2005 MandrakeSoft SA |
6 |
#- Copyright (C) 2005-2010 Mandriva SA |
7 |
#- |
8 |
#- This program is free software; you can redistribute it and/or modify |
9 |
#- it under the terms of the GNU General Public License as published by |
10 |
#- the Free Software Foundation; either version 2, or (at your option) |
11 |
#- any later version. |
12 |
#- |
13 |
#- This program is distributed in the hope that it will be useful, |
14 |
#- but WITHOUT ANY WARRANTY; without even the implied warranty of |
15 |
#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
16 |
#- GNU General Public License for more details. |
17 |
#- |
18 |
#- You should have received a copy of the GNU General Public License |
19 |
#- along with this program; if not, write to the Free Software |
20 |
#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
21 |
|
22 |
use strict; |
23 |
use urpm; |
24 |
use urpm::args; |
25 |
use urpm::msg; |
26 |
use urpm::media; |
27 |
|
28 |
sub usage() { |
29 |
print N("urpmf version %s |
30 |
Copyright (C) 2002-2010 Mandriva. |
31 |
This is free software and may be redistributed under the terms of the GNU GPL. |
32 |
|
33 |
usage: urpmf [options] pattern-expression |
34 |
", $urpm::VERSION) |
35 |
. N(" --help - print this help message. |
36 |
") . N(" --version - print this tool's version number. |
37 |
") . N(" --env - use specific environment (typically a bug report). |
38 |
") . N(" --excludemedia - do not use the given media, separated by comma. |
39 |
") . N(" --literal, -l - don't match patterns, use argument as a literal string. |
40 |
") . N(" --urpmi-root - use another root for urpmi db & rpm installation. |
41 |
") . N(" --media - use only the given media, separated by comma. |
42 |
") . N(" --sortmedia - sort media according to substrings separated by comma. |
43 |
") . N(" --use-distrib - use the given path to access media |
44 |
") . N(" --synthesis - use the given synthesis instead of urpmi db. |
45 |
") . N(" --uniq - do not print identical lines twice. |
46 |
") . N(" --update - use only update media. |
47 |
") . N(" --verbose - verbose mode. |
48 |
") . N(" -i - ignore case distinctions in patterns. |
49 |
") . N(" -I - honor case distinctions in patterns (default). |
50 |
") . N(" -F<str> - change field separator (defaults to ':'). |
51 |
") . N("Pattern expressions: |
52 |
") . N(" text - any text is parsed as a regexp, unless -l is used. |
53 |
") . N(" -e - include perl code directly as perl -e. |
54 |
") . N(" -a - binary AND operator. |
55 |
") . N(" -o - binary OR operator. |
56 |
") . N(" ! - unary NOT. |
57 |
") . N(" ( ) - left and right parentheses. |
58 |
") . N("List of tags: |
59 |
") . N(" --qf - specify a printf-like output format |
60 |
") . N(" example: '%%name:%%files' |
61 |
") . N(" --arch - architecture |
62 |
") . N(" --buildhost - build host |
63 |
") . N(" --buildtime - build time |
64 |
") . N(" --conffiles - configuration files |
65 |
") . N(" --conflicts - conflict tags |
66 |
") . N(" --description - package description |
67 |
") . N(" --distribution - distribution |
68 |
") . N(" --epoch - epoch |
69 |
") . N(" --filename - filename of the package |
70 |
") . N(" --files - list of files contained in the package |
71 |
") . N(" --group - group |
72 |
") . N(" --license - license |
73 |
") . N(" --name - package name |
74 |
") . N(" --obsoletes - obsoletes tags |
75 |
") . N(" --packager - packager |
76 |
") . N(" --provides - provides tags |
77 |
") . N(" --requires - requires tags |
78 |
") . N(" --size - installed size |
79 |
") . N(" --sourcerpm - source rpm name |
80 |
") . N(" --suggests - suggests tags |
81 |
") . N(" --summary - summary |
82 |
") . N(" --url - url |
83 |
") . N(" --vendor - vendor |
84 |
") . N(" -m - the media in which the package was found |
85 |
") . N(" -f - print version, release and arch with name. |
86 |
"); |
87 |
exit(1); |
88 |
} |
89 |
|
90 |
my %tags_per_media_info = ( |
91 |
everywhere => [ qw( |
92 |
arch |
93 |
epoch |
94 |
filename |
95 |
name |
96 |
release |
97 |
version |
98 |
) ], |
99 |
|
100 |
synthesis => [ qw( |
101 |
conflicts |
102 |
group |
103 |
obsoletes |
104 |
provides |
105 |
requires |
106 |
size |
107 |
suggests |
108 |
summary |
109 |
) ], |
110 |
|
111 |
xml_info__info => [ qw( |
112 |
description |
113 |
license |
114 |
sourcerpm |
115 |
url |
116 |
) ], |
117 |
|
118 |
xml_info__files => [ qw( |
119 |
files |
120 |
) ], |
121 |
|
122 |
hdlist => [ qw( |
123 |
buildhost |
124 |
buildtime |
125 |
conf_files |
126 |
distribution |
127 |
packager |
128 |
vendor |
129 |
) ], |
130 |
); |
131 |
|
132 |
urpm::args::add_urpmf_cmdline_tags(map { @$_ } values %tags_per_media_info); |
133 |
|
134 |
#- default options. |
135 |
our $env; # bug report directory |
136 |
our $excludemedia = ''; |
137 |
our $full = ''; # -f : print rpm fullname instead of rpm name |
138 |
our $literal = 0; # should we quotemeta the pattern |
139 |
our $media = ''; |
140 |
our $pattern = ''; # regexp match flags ("i" or "") |
141 |
our $qf = '%default'; # format string |
142 |
our $separator = ':'; # default field separator |
143 |
our $sortmedia = ''; |
144 |
our $uniq = ''; # --uniq |
145 |
our $update = 0; # --update |
146 |
|
147 |
#- globals used in callback |
148 |
our ($expr, $left_expr); # regexp to match against |
149 |
our %uniq; |
150 |
|
151 |
#- parse arguments list. |
152 |
my $urpm = urpm->new_parse_cmdline or exit(1); |
153 |
defined $left_expr and $urpm->{fatal}(1, N("unterminated expression (%s)", $left_expr)); |
154 |
defined $expr or usage(); |
155 |
|
156 |
if ($qf eq '%default') { |
157 |
#- nothing on the command-line : default is to search on file names |
158 |
$qf = '%name' . $separator . '%files'; |
159 |
} else { |
160 |
#- else default to a leading %name |
161 |
$qf =~ s/%default\b/%name/; |
162 |
} |
163 |
|
164 |
#- replace first %name by %fullname if -f was specified |
165 |
if ($full) { $qf =~ s/%name\b/%fullname/ } |
166 |
|
167 |
#- we really don't want logs on stdout, and remove verbose if not asked. |
168 |
$urpm->{info} = sub { print STDERR "$_[0]\n" }; |
169 |
$urpm->{log} = sub { print STDERR "$_[0]\n" } if $options{verbose} > 0; |
170 |
|
171 |
my $only_simple_files_search; |
172 |
if ($qf eq '%name:%files') { |
173 |
if ($::literal) { |
174 |
$only_simple_files_search = $expr !~ /:/; |
175 |
} elsif (@::raw_non_literals == 1) { |
176 |
my $s = $::raw_non_literals[0]; |
177 |
$s =~ s!/.*!!; # things after "/" won't match pkg name for sure |
178 |
$only_simple_files_search = $s !~ m![:.*?\[\]]!; |
179 |
} |
180 |
$only_simple_files_search and $urpm->{log}("using fast algorithm"); |
181 |
} |
182 |
|
183 |
|
184 |
my $multitag = ''; |
185 |
my %multitags = map { $_ => 1 } qw(conffiles conflicts files obsoletes provides requires suggests); |
186 |
my %usedtags; |
187 |
|
188 |
(my $proto = $qf) =~ s/%([-\d]*)(\w+)/%${1}s/g; |
189 |
my $sprintfargs = join(', ', map { |
190 |
$usedtags{$_} = 1; |
191 |
if ($_ eq 'media') { |
192 |
'$medium->{name}'; |
193 |
} elsif ($_ eq 'fullname') { |
194 |
'scalar($pkg->fullname)'; |
195 |
} elsif ($_ eq 'description') { |
196 |
'do { my $d = $pkg->description; $d =~ s/^/\t/mg; "\n$d" }'; |
197 |
} elsif ($multitags{$_}) { |
198 |
$multitag and $urpm->{fatal}->(1, N("Incorrect format: you may use only one multi-valued tag")); |
199 |
$multitag = $_; |
200 |
"'%s'"; |
201 |
} else { |
202 |
'$pkg->' . $_; |
203 |
} |
204 |
} $qf =~ /%[-\d]*(\w+)/g); |
205 |
|
206 |
my ($proto_cooked, $sprintfargs_cooked); |
207 |
if ($multitag) { |
208 |
($proto_cooked, $sprintfargs_cooked) = ($proto, $sprintfargs); |
209 |
($proto, $sprintfargs) = ('$proto_cooked', '$mt'); |
210 |
} |
211 |
|
212 |
my $next_st = $multitag ? 'next' : 'return 0'; |
213 |
my @inner = ( |
214 |
'local $_;', |
215 |
"\$_ = sprintf(qq{$proto}, $sprintfargs);", |
216 |
"$expr or $next_st;", |
217 |
$uniq ? ('$uniq{$_} and ' . $next_st . ';', '$uniq{$_} = 1;') : (), |
218 |
'print $_, "\n";', |
219 |
); |
220 |
|
221 |
if ($multitag) { |
222 |
@inner = ( |
223 |
"my \$proto_cooked = sprintf(qq{$proto_cooked}, $sprintfargs_cooked);", |
224 |
"foreach my \$mt (\$pkg->$multitag) {", |
225 |
(map { " $_" } @inner), |
226 |
"}", |
227 |
); |
228 |
} |
229 |
|
230 |
#- build the callback matching the expression. |
231 |
my $callback = join("\n", |
232 |
"sub {", |
233 |
(map { " $_" } |
234 |
'my ($urpm, $pkg) = @_;', |
235 |
@inner, |
236 |
'0;'), |
237 |
"}"); |
238 |
|
239 |
$urpm->{debug}("qf:[$qf]\ncallback:\n$callback") if $urpm->{debug} && !$only_simple_files_search; |
240 |
our $medium; |
241 |
$callback = eval $callback; |
242 |
if ($@) { |
243 |
warn "Internal error: $@\n"; |
244 |
exit(1); |
245 |
} |
246 |
|
247 |
if ($env) { |
248 |
print N("using specific environment on %s\n", $env); |
249 |
#- setting new environment. |
250 |
$urpm->{config} = "$env/urpmi.cfg"; |
251 |
$urpm->{skiplist} = "$env/skip.list"; |
252 |
$urpm->{instlist} = "$env/inst.list"; |
253 |
$urpm->{statedir} = $env; |
254 |
} |
255 |
|
256 |
my $_lock = urpm::lock::urpmi_db($urpm, '', nofatal => 1, wait => $options{wait_lock}); |
257 |
|
258 |
my %needed_media_info = map { $_ => 1 } grep { |
259 |
my $l = $tags_per_media_info{$_}; |
260 |
int(grep { $usedtags{$_} } @$l); |
261 |
} keys %tags_per_media_info; |
262 |
|
263 |
my @needed_xml_info = map { s/xml_info__// ? $_ : @{[]} } keys %needed_media_info; |
264 |
if (@needed_xml_info > 1) { |
265 |
# we don't handle parallel parsing of xml files, default to hdlist |
266 |
$needed_media_info{hdlist} = 1; |
267 |
} |
268 |
|
269 |
my %fullname2pkg; |
270 |
urpm::media::configure($urpm, |
271 |
no_skiplist => 1, |
272 |
media => $media, |
273 |
excludemedia => $excludemedia, |
274 |
sortmedia => $sortmedia, |
275 |
synthesis => $options{synthesis}, |
276 |
usedistrib => $urpm::args::options{usedistrib}, |
277 |
update => $update, |
278 |
@needed_xml_info && $needed_media_info{synthesis} && !$needed_media_info{hdlist} ? |
279 |
# in that case, we need to have both synthesis and xml_info |
280 |
(callback => sub { |
281 |
my ($_urpm, $pkg) = @_; |
282 |
$fullname2pkg{$pkg->fullname} = $pkg; |
283 |
1; |
284 |
}) : (nodepslist => 1) |
285 |
); |
286 |
|
287 |
# nb: we don't "my" $medium since it is used for $callback |
288 |
if ($needed_media_info{hdlist}) { |
289 |
foreach $medium (urpm::media::non_ignored_media($urpm)) { |
290 |
my $hdlist = urpm::media::any_hdlist($urpm, $medium, $options{verbose} < 0) or |
291 |
$urpm->{error}(N("no hdlist available for medium \"%s\"", $medium->{name})), next; |
292 |
$urpm->{log}("getting information from $hdlist"); |
293 |
$urpm->parse_hdlist($hdlist, callback => $callback); |
294 |
} |
295 |
} elsif (!@needed_xml_info) { |
296 |
foreach $medium (urpm::media::non_ignored_media($urpm)) { |
297 |
my $synthesis = urpm::media::any_synthesis($urpm, $medium) or |
298 |
$urpm->{error}(N("no synthesis available for medium \"%s\"", $medium->{name})), next; |
299 |
$urpm->{log}("getting information from $synthesis"); |
300 |
$urpm->parse_synthesis($synthesis, callback => $callback); |
301 |
} |
302 |
} elsif (my ($xml_info) = @needed_xml_info) { |
303 |
foreach $medium (urpm::media::non_ignored_media($urpm)) { |
304 |
my $xml_info_file = urpm::media::any_xml_info($urpm, $medium, $xml_info, $options{verbose} < 0); |
305 |
if (!$xml_info_file) { |
306 |
my $hdlist = urpm::media::any_hdlist($urpm, $medium, $options{verbose} < 0) or |
307 |
$urpm->{error}(N("no xml-info available for medium \"%s\"", $medium->{name})), next; |
308 |
$urpm->{log}("getting information from $hdlist"); |
309 |
$urpm->parse_hdlist($hdlist, callback => $callback); |
310 |
next; |
311 |
} |
312 |
require urpm::xml_info; |
313 |
require urpm::xml_info_pkg; |
314 |
|
315 |
my $cooked_callback = $needed_media_info{synthesis} ? |
316 |
sub { |
317 |
my ($node) = @_; |
318 |
my $pkg = $fullname2pkg{$node->{fn}} or warn "can't find $node->{fn} in synthesis\n"; |
319 |
$pkg and $callback->($urpm, urpm::xml_info_pkg->new($node, $pkg)); |
320 |
} : sub { |
321 |
my ($node) = @_; |
322 |
$callback->($urpm, urpm::xml_info_pkg->new($node, undef)); |
323 |
}; |
324 |
$urpm->{log}("getting information from $xml_info_file"); |
325 |
if ($only_simple_files_search) { |
326 |
# special version for speed (3x faster), hopefully fully compatible |
327 |
my $code = sprintf(<<'EOF', $expr, $expr); |
328 |
my $F = urpm::xml_info::open_lzma($xml_info_file); |
329 |
my $fn; |
330 |
local $_; |
331 |
while (<$F>) { |
332 |
if (m!^<!) { |
333 |
($fn) = /fn="(.*)"/; |
334 |
} elsif (%s || ($fn =~ %s)) { |
335 |
$fn or $urpm->{fatal}(1, "fast algorithm is broken, please report a bug"); |
336 |
my $pkg = urpm::xml_info_pkg->new({ fn => $fn }); |
337 |
print $pkg->name, ':', $_; |
338 |
} |
339 |
} |
340 |
EOF |
341 |
$urpm->{debug} and $urpm->{debug}($code); |
342 |
eval $code; |
343 |
$@ and $urpm->{fatal}(1, $@); |
344 |
} else { |
345 |
urpm::xml_info::do_something_with_nodes( |
346 |
$xml_info, |
347 |
$xml_info_file, |
348 |
$cooked_callback, |
349 |
); |
350 |
} |
351 |
} |
352 |
} |