1# ex:ts=8 sw=4: 2# $OpenBSD: Installed.pm,v 1.37 2016/09/15 12:53:08 espie Exp $ 3# 4# Copyright (c) 2007-2014 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 21# XXX: we want to be able to load PackageRepository::Installed stand-alone, 22# so we put the only common method into PackageRepositoryBase. 23# 24# later, when we load the base PackageRepository, we tweak the inheritance 25# of PackageRepository::Installed to have full access... 26 27package OpenBSD::PackageRepositoryBase; 28 29my ($version, $current); 30 31sub is_local_file 32{ 33 return 0; 34} 35 36sub expand_locations 37{ 38 my ($class, $string, $state) = @_; 39 require OpenBSD::Paths; 40 if ($string eq '%a') { 41 return OpenBSD::Paths->machine_architecture; 42 } elsif ($string eq '%v') { 43 return OpenBSD::Paths->os_version; 44 } elsif ($string eq '%c') { 45 return OpenBSD::Paths->os_directory; 46 } elsif ($string eq '%m') { 47 return join('/', 48 'pub/OpenBSD', 49 OpenBSD::Paths->os_directory, 50 'packages', 51 OpenBSD::Paths->machine_architecture); 52 } 53} 54 55sub parse_url 56{ 57 my ($class, $r, $state) = @_; 58 59 my $path; 60 61 if ($$r =~ m/^(.*?)\:(.*)/) { 62 $path = $1; 63 $$r = $2; 64 } else { 65 $path = $$r; 66 $$r = ''; 67 } 68 69 $path =~ s/\%[vacm]\b/$class->expand_locations($&, $state)/ge; 70 $path .= '/' unless $path =~ m/\/$/; 71 bless { path => $path, state => $state }, $class; 72} 73 74sub parse_fullurl 75{ 76 my ($class, $r, $state) = @_; 77 78 $class->strip_urlscheme($r) or return undef; 79 return $class->parse_url($r, $state); 80} 81 82sub strip_urlscheme 83{ 84 my ($class, $r) = @_; 85 if ($$r =~ m/^(.*?)\:(.*)$/) { 86 my $scheme = lc($1); 87 if ($scheme eq $class->urlscheme) { 88 $$r = $2; 89 return 1; 90 } 91 } 92 return 0; 93} 94 95sub match_locations 96{ 97 my ($self, $search, @filters) = @_; 98 my $l = $search->match_locations($self); 99 while (my $filter = (shift @filters)) { 100 last if @$l == 0; # don't bother filtering empty list 101 $l = $filter->filter_locations($l); 102 } 103 return $l; 104} 105 106sub url 107{ 108 my ($self, $name) = @_; 109 return $self->urlscheme.':'.$self->relative_url($name); 110} 111 112sub finish_and_close 113{ 114 my ($self, $object) = @_; 115 $self->close($object); 116} 117 118sub close_now 119{ 120 my ($self, $object) = @_; 121 $self->close($object, 0); 122} 123 124sub close_after_error 125{ 126 my ($self, $object) = @_; 127 $self->close($object, 1); 128} 129 130sub close_with_client_error 131{ 132 my ($self, $object) = @_; 133 $self->close($object, 1); 134} 135 136sub canonicalize 137{ 138 my ($self, $name) = @_; 139 140 if (defined $name) { 141 $name =~ s/\.tgz$//o; 142 } 143 return $name; 144} 145 146sub new_location 147{ 148 my ($self, @args) = @_; 149 150 return $self->locationClassName->new($self, @args); 151} 152 153sub locationClassName 154{ "OpenBSD::PackageLocation" } 155 156sub locations_list 157{ 158 my $self = shift; 159 if (!defined $self->{locations}) { 160 my $l = []; 161 require OpenBSD::PackageLocation; 162 163 for my $name (@{$self->list}) { 164 push @$l, $self->new_location($name); 165 } 166 $self->{locations} = $l; 167 } 168 return $self->{locations}; 169} 170 171sub reinitialize 172{ 173} 174 175package OpenBSD::PackageRepository::Installed; 176 177our @ISA = (qw(OpenBSD::PackageRepositoryBase)); 178 179sub urlscheme 180{ 181 return 'inst'; 182} 183 184use OpenBSD::PackageInfo (qw(is_installed installed_info 185 installed_packages installed_stems installed_name)); 186 187sub new 188{ 189 my ($class, $all, $state) = @_; 190 return bless { all => $all, state => $state }, $class; 191} 192 193sub relative_url 194{ 195 my ($self, $name) = @_; 196 $name or ''; 197} 198 199sub close 200{ 201} 202 203sub make_error_file 204{ 205} 206 207sub canonicalize 208{ 209 my ($self, $name) = @_; 210 return installed_name($name); 211} 212 213sub find 214{ 215 my ($repository, $name, $arch) = @_; 216 my $self; 217 218 if (is_installed($name)) { 219 require OpenBSD::PackageLocation; 220 221 $self = $repository->new_location($name); 222 $self->{dir} = installed_info($name); 223 } 224 return $self; 225} 226 227sub locationClassName 228{ "OpenBSD::PackageLocation::Installed" } 229 230sub grabPlist 231{ 232 my ($repository, $name, $arch, $code) = @_; 233 require OpenBSD::PackingList; 234 return OpenBSD::PackingList->from_installation($name, $code); 235} 236 237sub available 238{ 239 my $self = shift; 240 return installed_packages($self->{all}); 241} 242 243sub list 244{ 245 my $self = shift; 246 my @list = installed_packages($self->{all}); 247 return \@list; 248} 249 250sub stemlist 251{ 252 return installed_stems(); 253} 254 255sub wipe_info 256{ 257} 258 259sub may_exist 260{ 261 my ($self, $name) = @_; 262 return is_installed($name); 263} 264 2651; 266