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