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