1# ex:ts=8 sw=4:
2# $OpenBSD: Installed.pm,v 1.38 2017/03/11 11:25:01 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 '%m') {
45		return join('/',
46		    'pub/OpenBSD',
47		    '%c',
48		    'packages',
49		    OpenBSD::Paths->machine_architecture);
50	}
51}
52
53sub parse_url
54{
55	my ($class, $r, $state) = @_;
56
57	my $path;
58
59	if ($$r =~ m/^(.*?)\:(.*)/) {
60		$path = $1;
61		$$r = $2;
62	} else {
63		$path = $$r;
64		$$r = '';
65	}
66
67	$path =~ s/\%[vam]\b/$class->expand_locations($&, $state)/ge;
68	# make %c magical: if we're on a release, we expand into
69	# stable, and leave the release dir for the full object with
70	# host to push back
71	my $release;
72	if ($path =~ m/\%c\b/) {
73		my $d = $state->defines('snap') ?
74		    'snapshots' : OpenBSD::Paths->os_directory;
75		if ($d ne 'snapshots' && $path =~ m,\%c/packages/,) {
76			$release = $path;
77			$release =~ s,\%c\b,$d,;
78			$path =~ s,\%c/packages/,$d/packages-stable/,;
79		} else {
80			$path =~ s,\%c\b,$d,;
81	    	}
82	}
83	$path .= '/' unless $path =~ m/\/$/;
84	bless { path => $path, release => $release, state => $state }, $class;
85}
86
87sub parse_fullurl
88{
89	my ($class, $r, $state) = @_;
90
91	$class->strip_urlscheme($r) or return undef;
92	return $class->parse_url($r, $state);
93}
94
95sub strip_urlscheme
96{
97	my ($class, $r) = @_;
98	if ($$r =~ m/^(.*?)\:(.*)$/) {
99		my $scheme = lc($1);
100		if ($scheme eq $class->urlscheme) {
101			$$r = $2;
102			return 1;
103	    	}
104	}
105	return 0;
106}
107
108sub match_locations
109{
110	my ($self, $search, @filters) = @_;
111	my $l = $search->match_locations($self);
112	while (my $filter = (shift @filters)) {
113		last if @$l == 0; # don't bother filtering empty list
114		$l = $filter->filter_locations($l);
115	}
116	return $l;
117}
118
119sub url
120{
121	my ($self, $name) = @_;
122	return $self->urlscheme.':'.$self->relative_url($name);
123}
124
125sub finish_and_close
126{
127	my ($self, $object) = @_;
128	$self->close($object);
129}
130
131sub close_now
132{
133	my ($self, $object) = @_;
134	$self->close($object, 0);
135}
136
137sub close_after_error
138{
139	my ($self, $object) = @_;
140	$self->close($object, 1);
141}
142
143sub close_with_client_error
144{
145	my ($self, $object) = @_;
146	$self->close($object, 1);
147}
148
149sub canonicalize
150{
151	my ($self, $name) = @_;
152
153	if (defined $name) {
154		$name =~ s/\.tgz$//o;
155	}
156	return $name;
157}
158
159sub new_location
160{
161	my ($self, @args) = @_;
162
163	return $self->locationClassName->new($self, @args);
164}
165
166sub locationClassName
167{ "OpenBSD::PackageLocation" }
168
169sub locations_list
170{
171	my $self = shift;
172	if (!defined $self->{locations}) {
173		my $l = [];
174		require OpenBSD::PackageLocation;
175
176		for my $name (@{$self->list}) {
177			push @$l, $self->new_location($name);
178		}
179		$self->{locations} = $l;
180	}
181	return $self->{locations};
182}
183
184sub reinitialize
185{
186}
187
188package OpenBSD::PackageRepository::Installed;
189
190our @ISA = (qw(OpenBSD::PackageRepositoryBase));
191
192sub urlscheme
193{
194	return 'inst';
195}
196
197use OpenBSD::PackageInfo (qw(is_installed installed_info
198    installed_packages installed_stems installed_name));
199
200sub new
201{
202	my ($class, $all, $state) = @_;
203	return bless { all => $all, state => $state }, $class;
204}
205
206sub relative_url
207{
208	my ($self, $name) = @_;
209	$name or '';
210}
211
212sub close
213{
214}
215
216sub make_error_file
217{
218}
219
220sub canonicalize
221{
222	my ($self, $name) = @_;
223	return installed_name($name);
224}
225
226sub find
227{
228	my ($repository, $name, $arch) = @_;
229	my $self;
230
231	if (is_installed($name)) {
232		require OpenBSD::PackageLocation;
233
234		$self = $repository->new_location($name);
235		$self->{dir} = installed_info($name);
236	}
237	return $self;
238}
239
240sub locationClassName
241{ "OpenBSD::PackageLocation::Installed" }
242
243sub grabPlist
244{
245	my ($repository, $name, $arch, $code) = @_;
246	require OpenBSD::PackingList;
247	return  OpenBSD::PackingList->from_installation($name, $code);
248}
249
250sub available
251{
252	my $self = shift;
253	return installed_packages($self->{all});
254}
255
256sub list
257{
258	my $self = shift;
259	my @list = installed_packages($self->{all});
260	return \@list;
261}
262
263sub stemlist
264{
265	return installed_stems();
266}
267
268sub wipe_info
269{
270}
271
272sub may_exist
273{
274	my ($self, $name) = @_;
275	return is_installed($name);
276}
277
2781;
279