1# ex:ts=8 sw=4:
2# $OpenBSD: PkgConfig.pm,v 1.12 2024/02/11 03:57:10 gkoehler Exp $
3#
4# Copyright (c) 2006 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
17use v5.36;
18
19
20# interface to the *.pc file format of pkg-config.
21package OpenBSD::PkgConfig;
22
23# specific properties may have specific needs.
24
25my $parse = {
26	Requires => sub($req) {
27	    my @l = split(/[,\s]+/, $req);
28	    my @r = ();
29	    while (@l > 0) {
30		    my $n = shift @l;
31		    if ($n =~ m/[<=>]+$/) {
32			    if (@l > 0) {
33				    $n .= shift @l;
34			    }
35		    }
36		    if ($n =~ m/^[<=>]+/) {
37			    if (@r > 0) {
38				    $n = (pop @r).$n;
39			    }
40		    }
41		    push(@r, $n);
42	    }
43	    return \@r;
44	},
45};
46
47
48my $write = {
49	Libs => sub($arg) { " ".__PACKAGE__->compress($arg) }
50};
51
52$parse->{'Requires.private'} = $parse->{Requires};
53$write->{'Libs.private'} = $write->{Libs};
54
55sub new($class)
56{
57	return bless {
58		variables => {},
59		vlist => [],
60		properties => {},
61		proplist => []
62	}, $class;
63}
64
65sub add_variable($self, $name, $value)
66{
67	if (defined $self->{variables}{$name}) {
68		die "Duplicate variable $name";
69	}
70	push(@{$self->{vlist}}, $name);
71	$self->{variables}{$name} = ($value =~ s/^\"|\"$//rg);
72}
73
74sub parse_value($self, $name, $value)
75{
76	my $class = "OpenBSD::PkgConfig::NoExpand";
77	if ($value =~ m/\$\{.*\}/) {
78		$class = "OpenBSD::PkgConfig::ToExpand";
79	}
80	if (defined $parse->{$name}) {
81		return bless $parse->{$name}($value), $class;
82	} else {
83		return bless [split /(?<!\\)\s+/o, $value], $class;
84	}
85}
86
87sub add_property($self, $name, $value)
88{
89	if ($name eq "CFlags") {
90		$name = "Cflags";
91	}
92	if (defined $self->{properties}{$name}) {
93		die "Duplicate property $name";
94	}
95	push(@{$self->{proplist}}, $name);
96	my $v;
97	if (defined $value) {
98		$v = $self->parse_value($name, $value);
99	} else {
100		$v = bless [], "OpenBSD::PkgConfig::NoExpand";
101	}
102	$self->{properties}{$name} = $v;
103}
104
105sub read_fh($class, $fh, $name = '')
106{
107	my $cfg = $class->new;
108
109	while (<$fh>) {
110		chomp;
111		# continuation lines
112		while (m/(?<!\\)\\$/) {
113			s/\\$//;
114			$_.=<$fh>;
115			chomp;
116		}
117		next if m/^\s*$/;
118		next if m/^\#/;
119		# zap comments
120		s/(?<!\\)\#.*//;
121		if (m/^([\w.]*)\s*\=\s*(.*)$/) {
122			$cfg->add_variable($1, $2);
123		} elsif (m/^([\w.]*)\:\s*(.*)$/) {
124			$cfg->add_property($1, $2);
125		} elsif (m/^([\w.]*)\:\s*$/) {
126			$cfg->add_property($1);
127		} else {
128			die "Incorrect cfg file $name";
129		}
130	}
131	if (defined $cfg->{properties}{Libs}) {
132		$cfg->{properties}{Libs} = bless
133		    $cfg->compress_list($cfg->{properties}{Libs}),
134		    ref($cfg->{properties}{Libs});
135	}
136	return $cfg;
137}
138
139sub read_file($class, $filename)
140{
141	open my $fh, '<:crlf', $filename or die "Can't open $filename: $!";
142	return $class->read_fh($fh, $filename);
143}
144
145sub write_fh($self, $fh)
146{
147	foreach my $variable (@{$self->{vlist}}) {
148		say $fh "$variable=", $self->{variables}{$variable};
149	}
150	print $fh "\n\n";
151	foreach my $property (@{$self->{proplist}}) {
152		my $p = $self->{properties}{$property};
153		print $fh "$property:";
154		if (defined $write->{$property}) {
155			print $fh $write->{$property}($p);
156		} else {
157			print $fh (map { " $_" } @$p);
158		}
159	    	print $fh "\n";
160	}
161}
162
163sub write_file($cfg, $filename)
164{
165	open my $fh, '>', $filename or die "Can't open $filename: $!";
166	$cfg->write_fh($fh);
167}
168
169sub compress_list($class, $l, $keep = undef)
170{
171	my $h = {};
172	my $r = [];
173	foreach my $i (@$l) {
174		next if defined $h->{$i};
175		next if defined $keep && !&$keep($i);
176		push(@$r, $i);
177		$h->{$i} = 1;
178	}
179	return $r;
180}
181
182sub compress($class, $l, $keep = undef)
183{
184	return join(' ', @{$class->compress_list($l, $keep)});
185}
186
187sub rcompress($class, $l, $keep = undef)
188{
189	my @l2 = reverse @$l;
190	return join(' ', reverse @{$class->compress_list(\@l2, $keep)});
191}
192
193sub expanded($self, $v, $extra = {})
194{
195	my $get_value =
196	    sub($var) {
197		if (defined $extra->{$var}) {
198			if ($extra->{$var} =~ m/\$\{.*\}/ ) {
199				return undef;
200			} else {
201				return $extra->{$var};
202			}
203		} elsif (defined $self->{variables}{$var}) {
204			return $self->{variables}{$var};
205		} else {
206			return '';
207		}
208	    };
209
210	# Expand all variables, unless the returned value is defined as an
211	# as an unexpandable variable (such as with --defined-variable).
212	while ($v =~ m/\$\{(.*?)\}/) {
213		# Limit the expanded variable size if 64K to prevent a
214		# malicious .pc file from consuming too much memory.
215		die "Variable expansion overflow" if length($v) > 64 * 1024;
216
217		unless (defined &$get_value($1)) {
218			$v =~ s/\$\{(.*?)\}/$extra->{$1}/g;
219			last;
220		}
221		$v =~ s/\$\{(.*?)\}/&$get_value($1)/ge;
222	}
223	return $v;
224}
225
226sub get_property($self, $k, $extra = {})
227{
228	my $l = $self->{properties}{$k};
229	if (!defined $l) {
230		return undef;
231	}
232	if ($l->noexpand) {
233		return [@$l];
234	}
235	my $r = [];
236	for my $v (@$l) {
237		my $w = $self->expanded($v, $extra);
238		# Optimization: don't bother reparsing if value didn't change
239		if ($w ne $v) {
240			my $l = $self->parse_value($k, $w);
241			push(@$r, @$l);
242		} else {
243			push(@$r, $w);
244		}
245	}
246	return $r;
247}
248
249sub get_variable($self, $k, $extra = {})
250{
251	my $v = $self->{variables}{$k};
252	if (defined $v) {
253		return $self->expanded($v, $extra);
254	} else {
255		return undef;
256	}
257}
258
259# to be used to make sure a config does not depend on absolute path names,
260# e.g., $cfg->add_bases(X11R6 => '/usr/X11R6');
261
262sub add_bases($self, $extra)
263{
264	while (my ($k, $v) = each %$extra) {
265		for my $name (keys %{$self->{variables}}) {
266			$self->{variables}{$name} =~ s/\Q$v\E\b/\$\{\Q$k\E\}/g;
267		}
268		for my $name (keys %{$self->{properties}}) {
269			for my $e (@{$self->{properties}{$name}}) {
270				$e =~ s/\Q$v\E\b/\$\{\Q$k\E\}/g;
271			}
272		}
273		$self->{variables}{$k} = $v;
274		unshift(@{$self->{vlist}}, $k);
275	}
276}
277
278package OpenBSD::PkgConfig::NoExpand;
279our @ISA = qw(OpenBSD::PkgConfig);
280sub noexpand($)
281{
282	1
283}
284
285package OpenBSD::PkgConfig::ToExpand;
286our @ISA = qw(OpenBSD::PkgConfig);
287sub noexpand($)
288{
289	0
290}
2911;
292