diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-11-30 16:25:28 +0100 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2017-11-30 16:25:28 +0100 |
commit | a14e7a93f2e6c164cde74cc2359c28312cc814d1 (patch) | |
tree | 0b85f544e77eaf3ee1c44ab72c2182e2e441c808 | |
parent | 18c46014ea554d19989b6a1b3a773254fefda092 (diff) | |
download | slackbuilder-a14e7a93f2e6c164cde74cc2359c28312cc814d1.tar.gz slackbuilder-a14e7a93f2e6c164cde74cc2359c28312cc814d1.tar.bz2 |
Improve registry record matcher.
String conditions like "<OP>TEXT", where <OP> is a comparizon operator
are recognized. Thus, e.g. "version => '>=1.2' is treated as
"version => { '-ge' => '1.2' }"
* lib/SlackBuild/match.pm (match): Handle conditions like ">foo".
(matchtab): Provide aliases.
* lib/SlackBuild/Registry/Backend/FS.pm (lookup): Use
Registry::Record->matches to select matching records.
-rw-r--r-- | lib/SlackBuild/Registry/Backend/FS.pm | 38 | ||||
-rw-r--r-- | lib/SlackBuild/match.pm | 23 |
2 files changed, 31 insertions, 30 deletions
diff --git a/lib/SlackBuild/Registry/Backend/FS.pm b/lib/SlackBuild/Registry/Backend/FS.pm index d554f9e..2ecd27a 100644 --- a/lib/SlackBuild/Registry/Backend/FS.pm +++ b/lib/SlackBuild/Registry/Backend/FS.pm @@ -52,37 +52,15 @@ search criteria. =cut sub lookup { - my ($self, $pkg, %keys) = @_; + my ($self, $pkg, %cond) = @_; my $v; - my $pat = "$pkg-"; - $pat .= ($keys{version} || '*') . '-'; - $pat .= ($keys{arch} || '*') . '-'; - if ($keys{build}) { - $pat .= $keys{build}; - } - $pat .= '*'; + my $pat = "$pkg-*-*-*"; - my $rx = '^' . qr($pkg) . '-'; - $rx .= '(?<version>'; - if ($keys{version}) { - $rx .= qr($keys{version}); - } else { - $rx .= '\d+(\.\d+)+.*?'; - } - $rx .= ')-(?<arch>'; - if ($keys{arch}) { - $rx .= qr($keys{arch}); - } else { - $rx .= regexp_opt(@architectures); - } - $rx .= ')-(?<build>'; - if ($keys{build}) { - $rx .= qr($keys{build}); - } else { - $rx .= '\d+'; - } - $rx .= ')(?<pfx>.*)$'; + my $rx = '^' . qr($pkg) . '-' + . '(?<version>\d+(\.\d+)+.*?)-(?<arch>' + . regexp_opt(@architectures) + .= ')-(?<build>\d+)(?<rest>.*)$'; my @result = sort { my $d; @@ -96,7 +74,9 @@ sub lookup { } else { ($b->build || 1) <=> ($a->build || 1) } - } map { + } + grep { $_->matches(%cond) } + map { my ($name,$path,$suffix) = fileparse($_, @suffixes); if ($name =~ m{$rx}) { my $st = stat($_); diff --git a/lib/SlackBuild/match.pm b/lib/SlackBuild/match.pm index 9b99d95..9ddb9b9 100644 --- a/lib/SlackBuild/match.pm +++ b/lib/SlackBuild/match.pm @@ -12,26 +12,39 @@ my %matchtab = ( my ($a, $b) = @_; (looks_like_number($a) && looks_like_number($b)) ? $a == $b : $a eq $b; }, + '=' => '-eq', + '==' => '-eq', + -ne => sub { my ($a, $b) = @_; (looks_like_number($a) && looks_like_number($b)) ? $a != $b : $a ne $b; }, + '!=' => '-ne', + -lt => sub { my ($a, $b) = @_; (looks_like_number($a) && looks_like_number($b)) ? $a < $b : $a lt $b; }, + '<' => '-lt', + -le => sub { my ($a, $b) = @_; (looks_like_number($a) && looks_like_number($b)) ? $a <= $b : $a le $b; }, + '<=' => '-le', + -gt => sub { my ($a, $b) = @_; (looks_like_number($a) && looks_like_number($b)) ? $a > $b : $a gt $b; }, + '>' => '-gt', + -ge => sub { my ($a, $b) = @_; (looks_like_number($a) && looks_like_number($b)) ? $a > $b : $a ge $b; }, + '>=' => '-ge', + -in => sub { my ($a, $b) = @_; croak 'argument to -in must be array' @@ -54,10 +67,18 @@ sub match { } elsif (ref($pred) eq 'HASH') { croak "array must have 1 key" unless keys(%$pred) == 1; ($fun, $arg) = each %$pred; + } elsif ($pred =~ m{^([<=>]=?)(.*)}) { + $fun = $1; + $arg = $2; } else { - return $val == $pred; + $fun = '-eq'; + $arg = $pred; } + while (exists($matchtab{$fun}) && !ref($matchtab{$fun})) { + $fun = $matchtab{$fun}; + } + croak "unknown predicate: $fun" unless (exists($matchtab{$fun})); |