1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
#!/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 media listed 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 any patterns.
") . _(" -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
$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.
|
