From d18603f5447f8263149d9696724a18414d0a4595 Mon Sep 17 00:00:00 2001 From: espie Date: Thu, 8 Jun 2023 08:55:27 +0000 Subject: [PATCH] move to perl use v5.36 also fix a discrepancy wrt the "original" pkg-config thanks to tb@ for testing. --- usr.bin/pkg-config/OpenBSD/PkgConfig.pm | 108 +++++------ usr.bin/pkg-config/pkg-config | 233 +++++++++++------------- 2 files changed, 143 insertions(+), 198 deletions(-) diff --git a/usr.bin/pkg-config/OpenBSD/PkgConfig.pm b/usr.bin/pkg-config/OpenBSD/PkgConfig.pm index 757d1c8b49d..bdbbed87308 100644 --- a/usr.bin/pkg-config/OpenBSD/PkgConfig.pm +++ b/usr.bin/pkg-config/OpenBSD/PkgConfig.pm @@ -1,5 +1,5 @@ # ex:ts=8 sw=4: -# $OpenBSD: PkgConfig.pm,v 1.9 2023/01/25 19:06:50 millert Exp $ +# $OpenBSD: PkgConfig.pm,v 1.10 2023/06/08 08:55:27 espie Exp $ # # Copyright (c) 2006 Marc Espie # @@ -14,17 +14,16 @@ # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -use strict; -use warnings; +use v5.36; -# this is a 'special' package, interface to the *.pc file format of pkg-config. +# interface to the *.pc file format of pkg-config. package OpenBSD::PkgConfig; # specific properties may have specific needs. my $parse = { - Requires => sub { - my @l = split(/[,\s]+/, shift); + Requires => sub($req) { + my @l = split(/[,\s]+/, $req); my @r = (); while (@l > 0) { my $n = shift @l; @@ -46,16 +45,14 @@ my $parse = { my $write = { - Libs => sub { " ".__PACKAGE__->compress(shift) } + Libs => sub($arg) { " ".__PACKAGE__->compress($arg) } }; $parse->{'Requires.private'} = $parse->{Requires}; $write->{'Libs.private'} = $write->{Libs}; -sub new +sub new($class) { - my $class = shift; - return bless { variables => {}, vlist => [], @@ -64,9 +61,8 @@ sub new }, $class; } -sub add_variable +sub add_variable($self, $name, $value) { - my ($self, $name, $value) = @_; if (defined $self->{variables}{$name}) { die "Duplicate variable $name"; } @@ -74,9 +70,8 @@ sub add_variable $self->{variables}{$name} = ($value =~ s/^\"|\"$//rg); } -sub parse_value +sub parse_value($self, $name, $value) { - my ($self, $name, $value) = @_; if (defined $parse->{$name}) { return $parse->{$name}($value); } else { @@ -84,9 +79,8 @@ sub parse_value } } -sub add_property +sub add_property($self, $name, $value) { - my ($self, $name, $value) = @_; if (defined $self->{properties}{$name}) { die "Duplicate property $name"; } @@ -100,12 +94,10 @@ sub add_property $self->{properties}{$name} = $v; } -sub read_fh +sub read_fh($class, $fh, $name = '') { - my ($class, $fh, $name) = @_; my $cfg = $class->new; - $name //= ''; while (<$fh>) { chomp; # continuation lines @@ -135,20 +127,16 @@ sub read_fh return $cfg; } -sub read_file +sub read_file($class, $filename) { - my ($class, $filename) = @_; - open my $fh, '<:crlf', $filename or die "Can't open $filename: $!"; return $class->read_fh($fh, $filename); } -sub write_fh +sub write_fh($self, $fh) { - my ($self, $fh) = @_; - foreach my $variable (@{$self->{vlist}}) { - print $fh "$variable=", $self->{variables}{$variable}, "\n"; + say $fh "$variable=", $self->{variables}{$variable}; } print $fh "\n\n"; foreach my $property (@{$self->{proplist}}) { @@ -163,16 +151,14 @@ sub write_fh } } -sub write_file +sub write_file($cfg, $filename) { - my ($cfg, $filename) = @_; open my $fh, '>', $filename or die "Can't open $filename: $!"; $cfg->write_fh($fh); } -sub compress_list +sub compress_list($class, $l, $keep = undef) { - my ($class, $l, $keep) = @_; my $h = {}; my $r = []; foreach my $i (@$l) { @@ -184,60 +170,52 @@ sub compress_list return $r; } -sub compress +sub compress($class, $l, $keep = undef) { - my ($class, $l, $keep) = @_; return join(' ', @{$class->compress_list($l, $keep)}); } -sub rcompress +sub rcompress($class, $l, $keep = undef) { - my ($class, $l, $keep) = @_; my @l2 = reverse @$l; return join(' ', reverse @{$class->compress_list(\@l2, $keep)}); } -sub expanded +sub expanded($self, $v, $extra = {}) { - my ($self, $v, $extra) = @_; - - $extra = {} if !defined $extra; my $get_value = - sub { - my $var = shift; - if (defined $extra->{$var}) { - if ($extra->{$var} =~ m/\$\{.*\}/ ) { - return undef; - } else { - return $extra->{$var}; - } - } elsif (defined $self->{variables}{$var}) { - return $self->{variables}{$var}; + sub($var) { + if (defined $extra->{$var}) { + if ($extra->{$var} =~ m/\$\{.*\}/ ) { + return undef; } else { - return ''; + return $extra->{$var}; } - }; + } elsif (defined $self->{variables}{$var}) { + return $self->{variables}{$var}; + } else { + return ''; + } + }; # Expand all variables, unless the returned value is defined as an # as an unexpandable variable (such as with --defined-variable). while ($v =~ m/\$\{(.*?)\}/) { - # Limit the expanded variable size if 64K to prevent a - # malicious .pc file from consuming too much memory. - die "Variable expansion overflow" if length($v) > 64 * 1024; + # Limit the expanded variable size if 64K to prevent a + # malicious .pc file from consuming too much memory. + die "Variable expansion overflow" if length($v) > 64 * 1024; - unless (defined &$get_value($1)) { - $v =~ s/\$\{(.*?)\}/$extra->{$1}/g; - last; - } - $v =~ s/\$\{(.*?)\}/&$get_value($1)/ge; + unless (defined &$get_value($1)) { + $v =~ s/\$\{(.*?)\}/$extra->{$1}/g; + last; + } + $v =~ s/\$\{(.*?)\}/&$get_value($1)/ge; } return $v; } -sub get_property +sub get_property($self, $k, $extra = {}) { - my ($self, $k, $extra) = @_; - my $l = $self->{properties}{$k}; if (!defined $l) { return undef; @@ -256,10 +234,8 @@ sub get_property return $r; } -sub get_variable +sub get_variable($self, $k, $extra = {}) { - my ($self, $k, $extra) = @_; - my $v = $self->{variables}{$k}; if (defined $v) { return $self->expanded($v, $extra); @@ -271,10 +247,8 @@ sub get_variable # to be used to make sure a config does not depend on absolute path names, # e.g., $cfg->add_bases(X11R6 => '/usr/X11R6'); -sub add_bases +sub add_bases($self, $extra) { - my ($self, $extra) = @_; - while (my ($k, $v) = each %$extra) { for my $name (keys %{$self->{variables}}) { $self->{variables}{$name} =~ s/\Q$v\E\b/\$\{\Q$k\E\}/g; diff --git a/usr.bin/pkg-config/pkg-config b/usr.bin/pkg-config/pkg-config index 71a69b69bb3..29aaf47cb9f 100644 --- a/usr.bin/pkg-config/pkg-config +++ b/usr.bin/pkg-config/pkg-config @@ -1,5 +1,5 @@ #!/usr/bin/perl -# $OpenBSD: pkg-config,v 1.95 2020/09/15 07:18:45 jasper Exp $ +# $OpenBSD: pkg-config,v 1.96 2023/06/08 08:55:27 espie Exp $ # Copyright (c) 2006 Chris Kuethe # Copyright (c) 2011-2020 Jasper Lievisse Adriaanse @@ -16,14 +16,20 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; +use v5.36; use Config; use Getopt::Long; use File::Basename; use File::stat; use OpenBSD::PkgConfig; +use constant { + ONLY_I => 1, + ONLY_l => 2, + ONLY_L => 4, + ONLY_OTHER => 8 +}; + my @PKGPATH = qw(/usr/lib/pkgconfig /usr/local/lib/pkgconfig /usr/local/share/pkgconfig @@ -70,7 +76,7 @@ defined $ENV{PKG_CONFIG_DEBUG_SPEW} ? $mode{debug} = 1 : $mode{debug} = 0; if ($logfile) { open my $L, ">>" , $logfile or die; - print $L beautify_list($0, @ARGV), "\n"; + say $L beautify_list($0, @ARGV); close $L; } @@ -87,7 +93,7 @@ GetOptions( 'debug' => \$mode{debug}, 'help' => \&help, #does not return 'usage' => \&help, #does not return 'list-all' => \$mode{list}, - 'version' => sub { print "$version\n" ; exit(0);} , + 'version' => sub { say $version ; exit(0);} , 'errors-to-stdout' => sub { $mode{estdout} = 1}, 'print-errors' => sub { $mode{printerr} = 1}, 'silence-errors' => sub { $mode{printerr} = 0}, @@ -97,13 +103,13 @@ GetOptions( 'debug' => \$mode{debug}, 'print-requires' => \$mode{printrequires}, 'print-requires-private' => \$mode{printrequiresprivate}, - 'cflags' => sub { $mode{cflags} = 3}, - 'cflags-only-I' => sub { $mode{cflags} |= 1}, - 'cflags-only-other' => sub { $mode{cflags} |= 2}, - 'libs' => sub { $mode{libs} = 7}, - 'libs-only-l' => sub { $mode{libs} |= 1}, - 'libs-only-L' => sub { $mode{libs} |= 2}, - 'libs-only-other' => sub { $mode{libs} |= 4}, + 'cflags' => sub { $mode{cflags} = ONLY_I|ONLY_OTHER}, + 'cflags-only-I' => sub { $mode{cflags} |= ONLY_I}, + 'cflags-only-other' => sub { $mode{cflags} |= ONLY_OTHER}, + 'libs' => sub { $mode{libs} = ONLY_L|ONLY_l|ONLY_OTHER}, + 'libs-only-l' => sub { $mode{libs} |= ONLY_l}, + 'libs-only-L' => sub { $mode{libs} |= ONLY_L}, + 'libs-only-other' => sub { $mode{libs} |= ONLY_OTHER}, 'exists' => sub { $mode{exists} = 1} , 'validate' => sub { $mode{validate} = 1}, 'static' => sub { $mode{static} = 1}, @@ -164,29 +170,29 @@ my $top_config = []; # When we got here we're supposed to have had at least one # package as argument. -if (!@ARGV){ +if (!@ARGV) { say_error("No package name(s) specified."); exit 1; } # Return the next module from @ARGV, if it turns out to be a comma separated # module list, take the first one and put the rest back to the front. -sub get_next_module +sub get_next_module() { my $module = shift @ARGV; my $m; if ($module =~ m/,/) { my @ms = split(/,/, $module); $m = shift @ms; - unshift(@ARGV, @ms) if (scalar(@ms) > 0); + unshift(@ARGV, @ms) if @ms != 0; } else { - return $module; + return $module; } return $m; } -while (@ARGV){ +while (@ARGV) { my $p = get_next_module(); my $op = undef; my $v = undef; @@ -267,16 +273,15 @@ if ($mode{static}){ if ($mode{cflags} || $mode{libs} || $mode{variable}) { push @vlist, do_cflags($dep_cfg_list) if $mode{cflags}; push @vlist, do_libs($dep_cfg_list) if $mode{libs}; - print join(' ', @vlist), "\n" if $rc == 0; + say join(' ', @vlist) if $rc == 0; } exit $rc; ########################################################################### -sub handle_config +sub handle_config($p, $op, $v, $list) { - my ($p, $op, $v, $list) = @_; my $cfg = cache_find_config($p); unshift @$list, $p if defined $cfg; @@ -294,8 +299,7 @@ sub handle_config } } - my $get_props = sub { - my $property = shift; + my $get_props = sub($property) { my $pkg; # See if there's anything in the environment that we need to @@ -316,7 +320,7 @@ sub handle_config my $deps = $cfg->get_property($property, $variables); return unless defined $deps; for my $dep (@$deps) { - if ($dep =~ m/^(.*?)\s*([<=>]+)\s*([\d\.]+|[\d\.]+[\w]*[\d]+)$/) { + if ($dep =~ m/^(.*?)\s*([<=>]+)\s*([\d\.]+|[\d\.]+\w*\d+)$/) { handle_config($1, $2, $3, $list); } else { handle_config($dep, undef, undef, $list); @@ -339,10 +343,8 @@ sub handle_config # look for the .pc file in each of the PKGPATH elements. Return the path or # undef if it's not there -sub pathresolve +sub pathresolve($p) { - my ($p) = @_; - if ($allow_uninstalled && $p !~ m/\-uninstalled$/) { for my $d (@PKGPATH) { my $f = "$d/$p-uninstalled.pc"; @@ -362,13 +364,11 @@ sub pathresolve return undef; } -sub get_config +sub get_config($f) { - my ($f) = @_; - my $cfg; eval { - $cfg = OpenBSD::PkgConfig->read_file($f); + $cfg = OpenBSD::PkgConfig->read_file($f); }; if (!$@) { return validate_config($f, $cfg); @@ -378,10 +378,8 @@ sub get_config return undef; } -sub cache_find_config +sub cache_find_config($name) { - my $name = shift; - say_debug("processing $name"); if (exists $configs{$name}) { @@ -392,9 +390,8 @@ sub cache_find_config } # Required elements for a valid .pc file: Name, Description, Version -sub validate_config +sub validate_config($f, $cfg) { - my ($f, $cfg) = @_; my @required_elems = ('Name', 'Description', 'Version'); # Check if we're dealing with an empty file, but don't error out just @@ -417,7 +414,7 @@ sub validate_config # pkg-config won't install a pkg-config.pc file itself, but it may be # listed as a dependency in other files. so prime the cache with self. -sub setup_self +sub setup_self() { my $pkg_pc = OpenBSD::PkgConfig->new; $pkg_pc->add_property('Version', $version); @@ -427,10 +424,8 @@ sub setup_self $configs{'pkg-config'} = $pkg_pc; } -sub find_config +sub find_config($p) { - my ($p) = @_; - # Differentiate between getting a full path and just the module name. my $f = ($p =~ m/\.pc$/ ? $p : pathresolve($p)); @@ -441,11 +436,8 @@ sub find_config return undef; } -sub stringize +sub stringize($list, $sep = ',') { - my $list = shift; - my $sep = shift || ','; - if (defined $list) { return join($sep, @$list) } else { @@ -454,10 +446,8 @@ sub stringize } #if the variable option is set, pull out the named variable -sub do_variable +sub do_variable($p, $v) { - my ($p, $v) = @_; - my $cfg = cache_find_config($p); if (defined $cfg) { @@ -472,20 +462,18 @@ sub do_variable #if the modversion or print-provides options are set, #pull out the compiler flags -sub do_modversion +sub do_modversion($p) { - my ($p) = @_; - my $cfg = cache_find_config($p); if (defined $cfg) { my $value = $cfg->get_property('Version', $variables); if (defined $value) { if (defined($mode{printprovides})){ - print "$p = " . stringize($value) . "\n"; + say "$p = " , stringize($value); return undef; } else { - print stringize($value), "\n"; + say stringize($value); return undef; } } @@ -494,32 +482,29 @@ sub do_modversion } #if the cflags option is set, pull out the compiler flags -sub do_cflags +sub do_cflags($list) { - my $list = shift; - my $cflags = []; for my $pkg (@$list) { my $l = $configs{$pkg}->get_property('Cflags', $variables); PATH: for my $path (@$l) { for my $sys_path (@sys_includes) { - next PATH if ($path =~ /${sys_path}\/*$/); + next PATH if $path =~ /\Q${sys_path}\E\/*$/; } push(@$cflags, $path); } } my $a = OpenBSD::PkgConfig->compress($cflags, - sub { - local $_ = shift; - if (($mode{cflags} & 1) && /^-I/ || - ($mode{cflags} & 2) && !/^-I/) { + sub($r) { + if (($mode{cflags} & ONLY_I) && $r =~ /^-I/ || + ($mode{cflags} & ONLY_OTHER) && $r !~ /^-I/) { return 1; } else { return 0; } }); - if (defined($a) && defined($variables->{pc_sysrootdir})){ + if (defined($variables->{pc_sysrootdir})){ $a =~ s/[\w]?-I/$&$variables->{pc_sysrootdir}/g; } @@ -527,10 +512,8 @@ sub do_cflags } #if the lib option is set, pull out the linker flags -sub do_libs +sub do_libs($list) { - my $list = shift; - my $libs = []; # In static mode, we have to make sure we discover the libs in dependency @@ -556,11 +539,10 @@ sub do_libs # Get the linker path directives (-L) and store it in $a. # $b will be the actual libraries. - my $a = OpenBSD::PkgConfig->compress($libs, - sub { - local $_ = shift; - if (($mode{libs} & 2) && /^-L/ || - ($mode{libs} & 4) && !/^-[lL]/) { + my $r = OpenBSD::PkgConfig->compress_list($libs, + sub($r) { + if (($mode{libs} & ONLY_L) && $r =~ /^-L/ || + ($mode{libs} & ONLY_OTHER) && $r !~ /^-[lL]/) { return 1; } else { return 0; @@ -568,22 +550,23 @@ sub do_libs }); if (defined($variables->{pc_sysrootdir})){ - $a =~ s/[\w]?-[lL]/$&$variables->{pc_sysrootdir}/g; + for my $i (@$r) { + $i =~ s/[\w]?-[lL]/$&$variables->{pc_sysrootdir}/; + } } - if ($mode{libs} & 1) { - my $b = OpenBSD::PkgConfig->rcompress($libs, - sub { shift =~ m/^-l/; }); - return ($a, $b); - } else { - return $a; + if ($mode{libs} & ONLY_l) { + push(@$r, OpenBSD::PkgConfig->rcompress($libs, + sub($l) { $l =~ m/^-l/; })); } + return @$r; } #list all packages -sub do_list +sub do_list() { my ($p, $x, $y, @files, $fname, $name); + my $error = 0; for my $p (@PKGPATH) { @@ -616,7 +599,7 @@ sub do_list return $error; } -sub help +sub help(@) { print < $y; return -1 if $x < $y; return 0 if (($x == $y) and ($eq == 1)); @@ -780,10 +759,8 @@ sub compare_numeric } # got a package meeting the requested specific version? -sub versionmatch +sub versionmatch($cfg, $op, $want) { - my ($cfg, $op, $want) = @_; - # can't possibly match if we can't find the file return 0 if !defined $cfg; @@ -802,9 +779,8 @@ sub versionmatch elsif ($op eq '<=') { return $value <= 0; } } -sub mismatch +sub mismatch($p, $cfg, $op, $v) { - my ($p, $cfg, $op, $v) = @_; my $name = stringize($cfg->get_property('Name'), ' '); my $version = stringize($cfg->get_property('Version')); my $url = stringize($cfg->get_property('URL')); @@ -813,9 +789,8 @@ sub mismatch say_warning("You may find new versions of $name at $url") if $url; } -sub simplify_and_reverse +sub simplify_and_reverse($reqlist) { - my $reqlist = shift; my $dejavu = {}; my $result = []; @@ -829,10 +804,8 @@ sub simplify_and_reverse } # retrieve and print Requires(.private) -sub print_requires +sub print_requires($p) { - my ($p) = @_; - my $cfg = cache_find_config($p); if (defined($cfg)) { @@ -848,7 +821,7 @@ sub print_requires } if (defined($value)) { - print "$_\n" for @$value; + say $_ for @$value; return undef; } } @@ -856,30 +829,28 @@ sub print_requires $rc = 1; } -sub beautify_list +sub beautify_list(@p) { - return join(' ', map {"[$_]"} @_); + return join(' ', map {"[$_]"} @p); } -sub say_debug +sub say_debug($msg) { - say_msg(shift) if $mode{debug}; + say_msg($msg) if $mode{debug}; } -sub say_error +sub say_error($msg) { - say_msg(shift) if $mode{printerr} + say_msg($msg) if $mode{printerr} } -sub say_warning +sub say_warning($msg) { - say_msg(shift); + say_msg($msg); } -sub say_msg +sub say_msg($str) { - my $str = shift; - # If --errors-to-stdout was given, close STDERR (to be safe), # then dup the output to STDOUT and delete the key from %mode so we # won't keep checking it. STDERR stays dup'ed. @@ -889,5 +860,5 @@ sub say_msg delete($mode{estdout}); } - print STDERR $str, "\n"; + say STDERR $str; } -- 2.20.1