diff options
Diffstat (limited to 'usr.sbin/pkg_add/OpenBSD/PkgSpec.pm')
| -rw-r--r-- | usr.sbin/pkg_add/OpenBSD/PkgSpec.pm | 220 |
1 files changed, 220 insertions, 0 deletions
diff --git a/usr.sbin/pkg_add/OpenBSD/PkgSpec.pm b/usr.sbin/pkg_add/OpenBSD/PkgSpec.pm new file mode 100644 index 00000000000..574311f1bd2 --- /dev/null +++ b/usr.sbin/pkg_add/OpenBSD/PkgSpec.pm @@ -0,0 +1,220 @@ +# ex:ts=8 sw=4: +# $OpenBSD: PkgSpec.pm,v 1.1 2004/10/11 09:44:06 espie Exp $ +# +# Copyright (c) 2003-2004 Marc Espie <espie@openbsd.org> +# +# Permission to use, copy, modify, and distribute this software for any +# purpose with or without fee is hereby granted, provided that the above +# copyright notice and this permission notice appear in all copies. +# +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + +use strict; +use warnings; +package OpenBSD::PkgSpec; + +# one useful function: +# OpenBSD::PkgSpec::match($pattern, @list) -> @sublist +# note that @sublist may contain duplicates + +# all the shit that does handle package specifications +sub compare_pseudo_numbers +{ + my ($n, $m) = @_; + + my ($n1, $m1); + + if ($n =~ m/^\d+/) { + $n1 = $&; + $n = $'; + } + if ($m =~ m/^\d+/) { + $m1 = $&; + $m = $'; + } + + if ($n1 == $m1) { + return $n cmp $m; + } else { + return $n1 <=> $m1; + } +} + + +sub dewey_compare +{ + my ($a, $b) = @_; + my ($pa, $pb); + + unless ($b =~ m/p\d+$/) { # does the Dewey hold a p<number> ? + $a =~ s/p\d+$//; # No -> strip it from version. + } + + return 0 if $a =~ /^$b$/; # bare equality + + if ($a =~ s/p(\d+)$//) { # extract patchlevels + $pa = $1; + } + if ($b =~ s/p(\d+)$//) { + $pb = $1; + } + + my @a = split(/\./, $a); + push @a, $pa if defined $pa; # ... and restore them + my @b = split(/\\\./, $b); + push @b, $pb if defined $pb; + while (@a > 0 && @b > 0) { + my $va = shift @a; + my $vb = shift @b; + next if $va eq $vb; + return compare_pseudo_numbers($va, $vb); + } + if (@a > 0) { + return 1; + } else { + return -1; + } +} + +sub check_version +{ + my ($v, $spec) = @_; + local $_; + + # any version spec + return 1 if $spec eq '.*'; + + my @specs = split(/,/, $spec); + for (grep /^\d/, @specs) { # exact number: check match + return 1 if $v =~ /^$_$/; + return 1 if $v =~ /^${_}p\d+$/; # allows for recent patches + } + + # Last chance: dewey specs ? + my @deweys = grep !/^\d/, @specs; + for (@deweys) { + if (m/^\<\=|\>\=|\<|\>/) { + my ($op, $dewey) = ($&, $'); + my $compare = dewey_compare($v, $dewey); + return 0 if $op eq '<' && $compare >= 0; + return 0 if $op eq '<=' && $compare > 0; + return 0 if $op eq '>' && $compare <= 0; + return 0 if $op eq '>=' && $compare < 0; + } else { + return 0; # unknown spec type + } + } + return @deweys == 0 ? 0 : 1; +} + +sub check_1flavor +{ + my ($f, $spec) = @_; + local $_; + + for (split /-/, $spec) { + # must not be here + if (m/^\!/) { + return 0 if $f->{$'}; + # must be here + } else { + return 0 unless $f->{$_}; + } + } + return 1; +} + +sub check_flavor +{ + my ($f, $spec) = @_; + local $_; + # no flavor constraints + return 1 if $spec eq ''; + + $spec =~ s/^-//; + # retrieve all flavors + my %f = map +($_, 1), split /\-/, $f; + + # check each flavor constraint + for (split /,/, $spec) { + if (check_1flavor(\%f, $_)) { + return 1; + } + } + return 0; +} + +sub subpattern_match +{ + my ($p, $list) = @_; + local $_; + + my ($stemspec, $vspec, $flavorspec); + + + # then, guess at where the version number is if any, + + # this finds patterns like -<=2.3,>=3.4.p1- + # the only constraint is that the actual number + # - must start with a digit, + # - not contain - or , + if ($p =~ m/\-((?:\>|\>\=|\<|\<\=)?\d[^-]*)/) { + ($stemspec, $vspec, $flavorspec) = ($`, $1, $'); + # `any version' matcher + } elsif ($p =~ m/\-\*/) { + ($stemspec, $vspec, $flavorspec) = ($`, '*', $'); + # okay, so no version marker. Assume no flavor spec. + } else { + ($stemspec, $vspec, $flavorspec) = ($p, '', ''); + } + + $stemspec =~ s/\./\\\./g; + $stemspec =~ s/\+/\\\+/g; + $stemspec =~ s/\*/\.\*/g; + $stemspec =~ s/\?/\./g; + $vspec =~ s/\./\\\./g; + $vspec =~ s/\+/\\\+/g; + $vspec =~ s/\*/\.\*/g; + $vspec =~ s/\?/\./g; + + $p = $stemspec; + $p.="-.*" if $vspec ne ''; + + # First trim down the list + my @l = grep {/^$p$/} @$list; + + my @result = (); + # Now, have to extract the version number, and the flavor... + for (@l) { + my ($stem, $v, $flavor); + if (m/\-(\d[^-]*)/) { + ($stem, $v, $flavor) = ($`, $1, $'); + if ($stem =~ m/^$stemspec$/ && + check_version($v, $vspec) && + check_flavor($flavor, $flavorspec)) { + push(@result, $_); + } + } + } + + return @result; +} + +sub match +{ + my ($pattern, @list) = @_; + my @l = (); + + for my $subpattern (split /\|/, $pattern) { + push(@l, subpattern_match($subpattern, \@list)); + } + return @l; +} + +1; |