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