# ex:ts=8 sw=4: # $OpenBSD: Search.pm,v 1.10 2009/04/19 15:18:23 espie Exp $ # # Copyright (c) 2007 Marc Espie # # 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. package OpenBSD::Search; sub match_locations { my ($self, $o) = @_; require OpenBSD::PackageLocation; my @l = map {$o->new_location($_)} $self->match($o); return \@l; } # XXX this is not efficient sub filter_locations { my ($self, $l) = @_; my $r = []; for my $loc (@$l) { if ($self->filter($loc->{name})) { push(@$r, $loc); } } return $r; } package OpenBSD::Search::PkgSpec; our @ISA=(qw(OpenBSD::Search)); sub match_ref { my ($self, $r) = @_; return $self->{spec}->match_ref($r); } sub match { my ($self, $o) = @_; return $self->match_ref($o->list); } sub match_locations { my ($self, $o) = @_; return $self->{spec}->match_locations($o->locations_list); } sub filter_locations { my ($self, $l) = @_; return $self->{$spec}->match_locations($l); } sub filter { my ($self, @list) = @_; return $self->match_ref(\@list); } sub new { my ($class, $pattern) = @_; require OpenBSD::PkgSpec; bless { spec => $class->spec_class->new($pattern)}, $class; } sub add_pkgpath_hint { my ($self, $pkgpath) = @_; $self->{pkgpath} = $pkgpath; } sub spec_class { "OpenBSD::PkgSpec" } package OpenBSD::Search::Exact; our @ISA=(qw(OpenBSD::Search::PkgSpec)); sub spec_class { "OpenBSD::PkgSpec::Exact" } package OpenBSD::Search::Stem; our @ISA=(qw(OpenBSD::Search)); sub new { my ($class, $stem) = @_; return bless {stem => $stem}, $class; } sub split { my ($class, $pkgname) = @_; require OpenBSD::PackageName; return $class->new(OpenBSD::PackageName::splitstem($pkgname)); } sub match { my ($self, $o) = @_; return $o->stemlist->find($self->{stem}); } sub _keep { my ($self, $stem) = @_; return $self->{stem} eq $stem; } sub filter { my ($self, @l) = @_; my @result = (); require OpenBSD::PackageName; for my $pkg (@l) { if ($self->_keep(OpenBSD::PackageName::splitstem($pkgname))) { push(@result, $pkg); } } return @result; } package OpenBSD::Search::PartialStem; our @ISA=(qw(OpenBSD::Search::Stem)); sub match { my ($self, $o) = @_; return $o->stemlist->find_partial($self->{stem}); } sub _keep { my ($self, $stem) = @_; my $partial = $self->{stem}; return $stem =~ /\Q$partial\E/; } package OpenBSD::Search::Filter; our @ISA=(qw(OpenBSD::Search)); sub new { my ($class, $code) = @_; return bless {code => $code}, $class; } sub filter { my ($self, @l) = @_; return &{$self->{code}}(@l); } package OpenBSD::Search::FilterLocation; our @ISA=(qw(OpenBSD::Search)); sub new { my ($class, $code) = @_; return bless {code => $code}, $class; } sub filter_locations { my ($self, $l) = @_; return &{$self->{code}}($l); } sub keep_most_recent { my $class = shift; return $class->new( sub { my $l = shift; # no need to filter return $l if @$l <= 1; require OpenBSD::PackageName; my $h = {}; # we have to prove we have to keep it while (my $e = pop @$l) { my $stem = $e->pkgname->{stem}; my $keep = 1; # so let's compare with every element in $h with the same stem for my $f (@{$h->{$e->pkgname->{stem}}}) { # if this is not the same flavors, # we don't filter if ($f->pkgname->flavor_string ne $e->pkgname->flavor_string) { next; } # okay, now we need to prove there's a common pkgpath if (!$e->update_info->match_pkgpath($f->update_info)) { next; } if ($f->pkgname->{version}->compare($e->pkgname->{version}) < 0) { $f = $e; } $keep = 0; last; } if ($keep) { push(@{$h->{$e->pkgname->{stem}}}, $e); } } my $largest = []; push @$largest, map {@$_} values %$h; return $largest; } ); } 1;