1# ex:ts=8 sw=4:
2# $OpenBSD: PackageName.pm,v 1.58 2023/06/13 09:07:17 espie Exp $
3#
4# Copyright (c) 2003-2010 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 v5.36;
19
20package OpenBSD::PackageName;
21
22sub url2pkgname($name)
23{
24	$name =~ s|.*/||;
25	$name =~ s|\.tgz$||;
26
27	return $name;
28}
29
30# see packages-specs(7)
31sub splitname($n)
32{
33	if ($n =~ /^(.*?)\-(\d.*)$/o) {
34		my $stem = $1;
35		my $rest = $2;
36		my @all = split /\-/o, $rest;
37		return ($stem, @all);
38	} else {
39		return ($n);
40	}
41}
42
43my $cached = {};
44
45sub from_string($class, $s)
46{
47	return $cached->{$s} //= $class->new_from_string($s);
48}
49
50sub new_from_string($class, $n)
51{
52	if ($n =~ /^(.*?)\-(\d.*)$/o) {
53		my $stem = $1;
54		my $rest = $2;
55		my @all = split /\-/o, $rest;
56		my $version = OpenBSD::PackageName::version->from_string(shift @all);
57		return bless {
58			stem => $stem,
59			version => $version,
60			flavors => { map {($_, 1)} @all },
61		}, "OpenBSD::PackageName::Name";
62	} else {
63		return bless {
64			stem => $n,
65		}, "OpenBSD::PackageName::Stem";
66	}
67}
68
69sub splitstem($s)
70{
71	if ($s =~ /^(.*?)\-\d/o) {
72		return $1;
73	} else {
74		return $s;
75	}
76}
77
78sub pkg2stem($pkg)
79{
80	my $s = splitstem($pkg);
81	$s =~ tr/A-Z/a-z/;
82	return $s;
83
84}
85sub is_stem($s)
86{
87	if ($s =~ m/\-\d/o || $s eq '-') {
88		return 0;
89	} else {
90		return 1;
91	}
92}
93
94sub compile_stemlist(@p)
95{
96	my $hash = {};
97	for my $n (@p) {
98		$hash->{pkg2stem($n)}{$n} = 1;
99	}
100	bless $hash, "OpenBSD::PackageLocator::_compiled_stemlist";
101}
102
103sub avail2stems(@p)
104{
105	return compile_stemlist(@p);
106}
107
108package OpenBSD::PackageLocator::_compiled_stemlist;
109
110sub find($self, $stem)
111{
112	$stem =~ tr/A-Z/a-z/;
113	return keys %{$self->{$stem}};
114}
115
116sub add($self, $pkgname)
117{
118	$self->{OpenBSD::PackageName::pkg2stem($pkgname)}{$pkgname} = 1;
119}
120
121sub delete($self, $pkgname)
122{
123	my $stem = OpenBSD::PackageName::pkg2stem($pkgname);
124	delete $self->{$stem}{$pkgname};
125	if(keys %{$self->{$stem}} == 0) {
126		delete $self->{$stem};
127	}
128}
129
130sub find_partial($self, $partial)
131{
132	my @result = ();
133	while (my ($stem, $pkgs) = each %$self) {
134		next unless $stem =~ /\Q$partial\E/i;
135		push(@result, keys %$pkgs);
136	}
137	return @result;
138}
139
140package OpenBSD::PackageName::dewey;
141
142my $cache = {};
143
144sub from_string($class, $string)
145{
146	my $o = bless { deweys => [ split(/\./o, $string) ],
147		suffix => '', suffix_value => 0}, $class;
148	if ($o->{deweys}->[-1] =~ m/^(\d+)(rc|alpha|beta|pre|pl)(\d*)$/) {
149		$o->{deweys}->[-1] = $1;
150		$o->{suffix} = $2;
151		$o->{suffix_value} = $3;
152	}
153	return $o;
154}
155
156sub make($class, $string)
157{
158	return $cache->{$string} //= $class->from_string($string);
159}
160
161sub to_string($self)
162{
163	my $r = join('.', @{$self->{deweys}});
164	if ($self->{suffix}) {
165		$r .= $self->{suffix} . $self->{suffix_value};
166	}
167	return $r;
168}
169
170sub suffix_compare($a, $b)
171{
172	if ($a->{suffix} eq $b->{suffix}) {
173		return $a->{suffix_value} <=> $b->{suffix_value};
174	}
175	if ($a->{suffix} eq 'pl') {
176		return 1;
177	}
178	if ($b->{suffix} eq 'pl') {
179		return -1;
180	}
181
182	if ($a->{suffix} gt $b->{suffix}) {
183		return -suffix_compare($b, $a);
184	}
185	# order is '', alpha, beta, pre, rc
186	# we know that a < b,
187	if ($a->{suffix} eq '') {
188		return 1;
189	}
190	if ($a->{suffix} eq 'alpha') {
191		return -1;
192	}
193	if ($a->{suffix} eq 'beta') {
194		return -1;
195	}
196	# refuse to compare pre vs. rc
197	return 0;
198}
199
200sub compare($a, $b)
201{
202	# Try a diff in dewey numbers first
203	for (my $i = 0; ; $i++) {
204		if (!defined $a->{deweys}->[$i]) {
205			if (!defined $b->{deweys}->[$i]) {
206				last;
207			} else {
208				return -1;
209			}
210		}
211		if (!defined $b->{deweys}->[$i]) {
212			return 1;
213		}
214		my $r = dewey_compare($a->{deweys}->[$i],
215			$b->{deweys}->[$i]);
216		return $r if $r != 0;
217	}
218	return suffix_compare($a, $b);
219}
220
221sub dewey_compare($a, $b)
222{
223	# numerical comparison
224	if ($a =~ m/^\d+$/o and $b =~ m/^\d+$/o) {
225		return $a <=> $b;
226	}
227	# added lowercase letter
228	if ("$a.$b" =~ m/^(\d+)([a-z]?)\.(\d+)([a-z]?)$/o) {
229		my ($an, $al, $bn, $bl) = ($1, $2, $3, $4);
230		if ($an != $bn) {
231			return $an <=> $bn;
232		} else {
233			return $al cmp $bl;
234		}
235	}
236	return $a cmp $b;
237}
238
239package OpenBSD::PackageName::version;
240
241sub p($self)
242{
243	return defined $self->{p} ? $self->{p} : -1;
244}
245
246sub v($self)
247{
248	return defined $self->{v} ? $self->{v} : -1;
249}
250
251sub from_string($class, $string)
252{
253	my $o = bless {}, $class;
254	if ($string =~ m/^(.*)v(\d+)$/o) {
255		$o->{v} = $2;
256		$string = $1;
257	}
258	if ($string =~ m/^(.*)p(\d+)$/o) {
259		$o->{p} = $2;
260		$string = $1;
261	}
262	$o->{dewey} = OpenBSD::PackageName::dewey->make($string);
263
264	return $o;
265}
266
267sub to_string($o)
268{
269	my $string = $o->{dewey}->to_string;
270	if (defined $o->{p}) {
271		$string .= 'p'.$o->{p};
272	}
273	if (defined $o->{v}) {
274		$string .= 'v'.$o->{v};
275	}
276	return $string;
277}
278
279sub pnum_compare($a, $b)
280{
281	return $a->p <=> $b->p;
282}
283
284sub compare($a, $b)
285{
286	# Simple case: epoch number
287	if ($a->v != $b->v) {
288		return $a->v <=> $b->v;
289	}
290	# Simple case: only p number differs
291	if ($a->{dewey} eq $b->{dewey}) {
292		return $a->pnum_compare($b);
293	}
294
295	return $a->{dewey}->compare($b->{dewey});
296}
297
298sub has_issues($self)
299{
300	if ($self->{dewey}{deweys}[-1] =~ m/v\d+$/ && defined $self->{p}) {
301		return ("correct order is pNvM");
302	} else {
303		return ();
304	}
305}
306
307package OpenBSD::PackageName::Stem;
308sub to_string($o)
309{
310	return $o->{stem};
311}
312
313sub to_pattern($o)
314{
315	return $o->{stem}.'-*';
316}
317
318sub has_issues($self)
319{
320	return ("is a stem");
321}
322
323package OpenBSD::PackageName::Name;
324sub flavor_string($o)
325{
326	return join('-', sort keys %{$o->{flavors}});
327}
328
329sub to_string($o)
330{
331	return join('-', $o->{stem}, $o->{version}->to_string,
332	    sort keys %{$o->{flavors}});
333}
334
335sub to_pattern($o)
336{
337	return join('-', $o->{stem}, '*', $o->flavor_string);
338}
339
340sub compare($a, $b)
341{
342	if ($a->{stem} ne $b->{stem} || $a->flavor_string ne $b->flavor_string) {
343		return undef;
344	}
345	return $a->{version}->compare($b->{version});
346}
347
348sub has_issues($self)
349{
350	return ((map {"flavor $_ can't start with digit"}
351	    	grep { /^\d/ } keys %{$self->{flavors}}),
352		$self->{version}->has_issues);
353}
354
3551;
356