diff options
Diffstat (limited to 'usr.sbin/pkg_add/OpenBSD/PackageName.pm')
| -rw-r--r-- | usr.sbin/pkg_add/OpenBSD/PackageName.pm | 219 |
1 files changed, 7 insertions, 212 deletions
diff --git a/usr.sbin/pkg_add/OpenBSD/PackageName.pm b/usr.sbin/pkg_add/OpenBSD/PackageName.pm index 9e180caca03..0447620ae00 100644 --- a/usr.sbin/pkg_add/OpenBSD/PackageName.pm +++ b/usr.sbin/pkg_add/OpenBSD/PackageName.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PackageName.pm,v 1.5 2004/08/06 07:51:17 espie Exp $ +# $OpenBSD: PackageName.pm,v 1.6 2004/10/11 09:44:06 espie Exp $ # # Copyright (c) 2003-2004 Marc Espie <espie@openbsd.org> # @@ -28,22 +28,6 @@ sub url2pkgname($) return $name; } -sub new -{ - my ($class, $name) = @_; - my $self = { name => $name }; -# remove irrelevant filesystem info - my $pkgname = url2pkgname($name); - $self->{pkgname} = $pkgname; -# cut pkgname into pieces - my @list = splitname($pkgname); - $self->{stem} = $list[0]; - $self->{version} = $list[1]; - $self->{flavors} = []; - push @{$self->{flavors}}, @list[2,]; - bless $self, $class; -} - # see package-specs(7) sub splitname { @@ -58,6 +42,11 @@ sub splitname } } +sub splitstem +{ + return (splitname $_[0])[0]; +} + sub is_stem { local $_ = shift; @@ -73,7 +62,7 @@ sub findstem my ($k, @list) = @_; my @r = (); for my $n (@list) { - my $stem = (splitname $n)[0]; + my $stem = splitstem($n); if ($k eq $stem) { push(@r, $n); } @@ -81,198 +70,4 @@ sub findstem return @r; } -# 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 pkgspec_match -{ - my ($pattern, @list) = @_; - my @l = (); - - for my $subpattern (split /\|/, $pattern) { - push(@l, subpattern_match($subpattern, \@list)); - } - return @l; -} - 1; |