summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xurpmf67
1 files changed, 25 insertions, 42 deletions
diff --git a/urpmf b/urpmf
index 1be612fc..3947341d 100755
--- a/urpmf
+++ b/urpmf
@@ -84,65 +84,48 @@ 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 {};
-unless (scalar(grep defined, values %params)) {
+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.
-my $callback = 'sub {
- my ($urpm, $pkg) = @_;';
-if ($uniq) {
- $uniq = "\n\t" . '$uniq{$_} and next; $uniq{$_} = 1;';
-}
-#- XXX name and fullname are for later
-foreach my $tag (grep { $params{$_} } qw(
- arch
- buildhost
- buildtime
- conf_files
- conflicts
- description
- distribution
- epoch
- filename
- files
- fullname
- group
- media
- name
- obsoletes
- packager
- provides
- requires
- size
- sourcerpm
- summary
- url
- vendor
-)) {
- my $fi = $tag eq 'media' ? '$urpm::currentmedia->{name}' : '$pkg->' . $tag;
- $callback .= qq{
- foreach my \$e ($fi) {
- local \$_ = \$pkg->${full}name.":\$e";
- $expr or next;$uniq
- print "\$_\\n";
- }};
+#- XXX it would be nice to use "my $_" in this callback.
+my $callback = qq<sub {
+ my (\$urpm, \$pkg) = \@_;
+ local *_; \$_ = sprintf(qq{$qf\\n}>;
+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 .= '
+$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}(N("callback is:\n%s\n", $callback)) if our $debug;
+}>;
+$urpm->{error}("qf:[$qf]\ncallback:\n$callback") if our $debug;
$callback = eval $callback;
if ($@) {
$debug and warn "Internal error: $@\n";