1# ex:ts=8 sw=4: 2# $OpenBSD: Search.pm,v 1.29 2016/06/14 15:41:31 espie Exp $ 3# 4# Copyright (c) 2007 Marc Espie <espie@openbsd.org> 5# 6# Permission to use, copy, modify, and distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17 18use strict; 19use warnings; 20 21package OpenBSD::Search; 22sub match_locations 23{ 24 my ($self, $o) = @_; 25 require OpenBSD::PackageLocation; 26 27 my @l = map {$o->new_location($_)} $self->match($o); 28 return \@l; 29} 30 31package OpenBSD::Search::PkgSpec; 32our @ISA=(qw(OpenBSD::Search)); 33 34sub filter 35{ 36 my ($self, @list) = @_; 37 return $self->{spec}->match_ref(\@list); 38} 39 40sub filter_libs 41{ 42 my ($self, @list) = @_; 43 return $self->{spec}->match_libs_ref(\@list); 44} 45 46sub match_locations 47{ 48 my ($self, $o) = @_; 49 return $self->{spec}->match_locations($o->locations_list); 50} 51 52sub filter_locations 53{ 54 my ($self, $l) = @_; 55 return $self->{spec}->match_locations($l); 56} 57 58sub new 59{ 60 my ($class, $pattern, $with_partial) = @_; 61 require OpenBSD::PkgSpec; 62 63 bless { spec => $class->spec_class->new($pattern, $with_partial)}, 64 $class; 65} 66 67sub add_pkgpath_hint 68{ 69 my ($self, $pkgpath) = @_; 70 $self->{pkgpath} = $pkgpath; 71 return $self; 72} 73 74sub spec_class 75{ "OpenBSD::PkgSpec" } 76 77sub is_valid 78{ 79 my $self = shift; 80 return $self->{spec}->is_valid; 81} 82 83package OpenBSD::Search::Exact; 84our @ISA=(qw(OpenBSD::Search::PkgSpec)); 85sub spec_class 86{ "OpenBSD::PkgSpec::Exact" } 87 88package OpenBSD::Search::Stem; 89our @ISA=(qw(OpenBSD::Search)); 90 91sub new 92{ 93 my ($class, $stem) = @_; 94 if ($stem =~ m/^(.*)\%(.*)/) { 95 return ($class->_new($1), 96 OpenBSD::Search::FilterLocation->match_partialpath($2)); 97 } else { 98 return $class->_new($stem); 99 } 100} 101 102sub _new 103{ 104 my ($class, $stem) = @_; 105 106 if ($stem =~ m/^(.*)\-\-(.*)/) { 107 # XXX 108 return OpenBSD::Search::Exact->new("$1-*-$2"); 109 } 110 return bless {"$stem" => 1}, $class; 111} 112 113sub split 114{ 115 my ($class, $pkgname) = @_; 116 require OpenBSD::PackageName; 117 118 return $class->new(OpenBSD::PackageName::splitstem($pkgname)); 119} 120 121sub add_stem 122{ 123 my ($self, $extra) = @_; 124 $self->{$extra} = 1; 125 126} 127 128sub match 129{ 130 my ($self, $o) = @_; 131 132 my @r = (); 133 for my $k (keys %$self) { 134 push(@r, $o->stemlist->find($k)); 135 } 136 return @r; 137} 138 139sub _keep 140{ 141 my ($self, $stem) = @_; 142 return defined $self->{$stem}; 143} 144 145sub filter 146{ 147 my ($self, @l) = @_; 148 my @result = (); 149 require OpenBSD::PackageName; 150 for my $pkg (@l) { 151 if ($self->_keep(OpenBSD::PackageName::splitstem($pkg))) { 152 push(@result, $pkg); 153 } 154 } 155 return @result; 156} 157 158package OpenBSD::Search::PartialStem; 159our @ISA=(qw(OpenBSD::Search::Stem)); 160 161sub match 162{ 163 my ($self, $o) = @_; 164 my @r = (); 165 for my $k (keys %$self) { 166 push(@r, $o->stemlist->find_partial($k)); 167 } 168 return @r; 169} 170 171sub _keep 172{ 173 my ($self, $stem) = @_; 174 for my $partial (keys %$self) { 175 if ($stem =~ /\Q$partial\E/) { 176 return 1; 177 } 178 } 179 return 0; 180} 181 182package OpenBSD::Search::FilterLocation; 183our @ISA=(qw(OpenBSD::Search)); 184sub new 185{ 186 my ($class, $code) = @_; 187 188 return bless {code => $code}, $class; 189} 190 191sub filter_locations 192{ 193 my ($self, $l) = @_; 194 return &{$self->{code}}($l); 195} 196 197sub more_recent_than 198{ 199 my ($class, $name, $rfound) = @_; 200 require OpenBSD::PackageName; 201 202 my $f = OpenBSD::PackageName->from_string($name); 203 204 return $class->new( 205sub { 206 my $l = shift; 207 my $r = []; 208 for my $e (@$l) { 209 if ($f->{version}->compare($e->pkgname->{version}) <= 0) { 210 push(@$r, $e); 211 } 212 if (ref $rfound) { 213 $$rfound = 1; 214 } 215 } 216 return $r; 217 }); 218} 219 220sub keep_most_recent 221{ 222 my $class = shift; 223 return $class->new( 224sub { 225 my $l = shift; 226 # no need to filter 227 return $l if @$l <= 1; 228 229 require OpenBSD::PackageName; 230 my $h = {}; 231 # we have to prove we have to keep it 232 while (my $e = pop @$l) { 233 my $stem = $e->pkgname->{stem}; 234 my $keep = 1; 235 # so let's compare with every element in $h with the same stem 236 for my $f (@{$h->{$e->pkgname->{stem}}}) { 237 # if this is not the same flavors, 238 # we don't filter 239 if ($f->pkgname->flavor_string ne $e->pkgname->flavor_string) { 240 next; 241 } 242 # okay, now we need to prove there's a common pkgpath 243 if (!$e->update_info->match_pkgpath($f->update_info)) { 244 next; 245 } 246 247 if ($f->pkgname->{version}->compare($e->pkgname->{version}) < 0) { 248 $f = $e; 249 } 250 $keep = 0; 251 last; 252 253 } 254 if ($keep) { 255 push(@{$h->{$e->pkgname->{stem}}}, $e); 256 } 257 } 258 my $largest = []; 259 push @$largest, map {@$_} values %$h; 260 return $largest; 261} 262 ); 263} 264 265sub match_partialpath 266{ 267 my ($class, $subdir) = @_; 268 return $class->new( 269sub { 270 my $l = shift; 271 if (@$l == 0) { 272 return $l; 273 } 274 my @l2 = (); 275 for my $loc (@$l) { 276 if (!$loc) { 277 next; 278 } 279 my $p2 = $loc->update_info; 280 if (!$p2) { 281 next; 282 } 283 if ($p2->pkgpath->partial_match($subdir)) { 284 push(@l2, $loc); 285 } 286 } 287 return \@l2; 288} 289 ); 290} 291 2921; 293