- move to 5.36: signatures + prototypes mostly everywhere
Not used for Getopt::Long, because the calling conventions are somewhat
too verbose.
- use constant for the mode{libs} and mode{cflags} values
- remove two completely unneeded [] in regexps
- fix indentation and parentheses in a few locations
There should be no behavior change, please test.
Deeper question: as it stands \w and such do handle unicode, more or less.
Is this something we actually want/need in pkg-config ? should we look at
restricting the regexps through one of the locale modifiers ?
Index: pkg-config
===================================================================
RCS file: /cvs/src/usr.bin/pkg-config/pkg-config,v
retrieving revision 1.95
diff -u -p -r1.95 pkg-config
--- pkg-config 15 Sep 2020 07:18:45 -0000 1.95
+++ pkg-config 22 May 2023 07:22:10 -0000
@@ -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} ? $m
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},
@@ -178,9 +184,9 @@ sub get_next_module
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;
@@ -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;
@@ -316,7 +321,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 +344,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 +365,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 +379,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 +391,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 +415,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 +425,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 +437,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 +447,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 +463,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,26 +483,23 @@ 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;
@@ -527,10 +513,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
@@ -557,10 +541,9 @@ 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]/) {
+ sub($r) {
+ if (($mode{libs} & ONLY_L) && $r =~ /^-L/ ||
+ ($mode{libs} & ONLY_l) && $r !~ /^-[lL]/) {
return 1;
} else {
return 0;
@@ -571,7 +554,7 @@ sub do_libs
$a =~ s/[\w]?-[lL]/$&$variables->{pc_sysrootdir}/g;
}
- if ($mode{libs} & 1) {
+ if ($mode{libs} & ONLY_l) {
my $b = OpenBSD::PkgConfig->rcompress($libs,
sub { shift =~ m/^-l/; });
return ($a, $b);
@@ -581,9 +564,10 @@ sub do_libs
}
#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 +600,7 @@ sub do_list
return $error;
}
-sub help
+sub help(@)
{
print <<EOF
Usage: $0 [options]
@@ -655,9 +639,8 @@ EOF
}
# do we meet/beat the version the caller requested?
-sub self_version
+sub self_version($v)
{
- my ($v) = @_;
my (@a, @b);
@a = split(/\./, $v);
@@ -670,9 +653,8 @@ sub self_version
}
}
-sub compare
+sub compare($a, $b)
{
- my ($a, $b) = @_;
my ($full_a, $full_b) = ($a, $b);
my (@suffix_a, @suffix_b);
@@ -769,10 +751,8 @@ sub compare
}
# simple numeric comparison, with optional equality test.
-sub compare_numeric
+sub compare_numeric($x, $y, $eq)
{
- my ($x, $y, $eq) = @_;
-
return 1 if $x > $y;
return -1 if $x < $y;
return 0 if (($x == $y) and ($eq == 1));
@@ -780,10 +760,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 +780,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 +790,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 +805,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 +822,7 @@ sub print_requires
}
if (defined($value)) {
- print "$_\n" for @$value;
+ say $_ for @$value;
return undef;
}
}
@@ -856,30 +830,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 +861,5 @@ sub say_msg
delete($mode{estdout});
}
- print STDERR $str, "\n";
+ say STDERR $str;
}
Index: OpenBSD/PkgConfig.pm
===================================================================
RCS file: /cvs/src/usr.bin/pkg-config/OpenBSD/PkgConfig.pm,v
retrieving revision 1.9
diff -u -p -r1.9 PkgConfig.pm
--- OpenBSD/PkgConfig.pm 25 Jan 2023 19:06:50 -0000 1.9
+++ OpenBSD/PkgConfig.pm 22 May 2023 07:22:10 -0000
@@ -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;
-
- unless (defined &$get_value($1)) {
- $v =~ s/\$\{(.*?)\}/$extra->{$1}/g;
- last;
- }
- $v =~ s/\$\{(.*?)\}/&$get_value($1)/ge;
+ # 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;
}
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;
