On Mon, May 22, 2023 at 09:33:48AM +0200, Marc Espie wrote:
> - 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.
Mostly this seems OK. There is one that isn't a behavior change, but
using $a and $b as names can sometimes cause confusing behavior, so I
generally try to avoid those names.
https://perldoc.perl.org/perlvar#$a
Changing the flag values from what they were makes it really hard for me
to tell if they are right. I think they all seem to have translated
properly, but wow, the new stuff is so much easier to read, I'm glad it
changed, but it was hard to review!
The rest _looked_ right, but I may have missed a typo. If so I expect
that would be obvious on running it.
> 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 ?
I assume we'll only want to support UTF-8, which is probably just adding
the "standard preamble" to switch undeclared file streams to use the
UTF-8 encoding.
https://perldoc.perl.org/perlunicook#%E2%84%9E-0:-Standard-preamble
https://perldoc.perl.org/perlunicook#%E2%84%9E-17:-Make-file-I/O-default-to-utf8
We can also switch the regex character classes to be limited to ascii.
https://perldoc.perl.org/perlunicook#%E2%84%9E-24:-Disabling-Unicode-awareness-in-builtin-charclasses
I don't know enough about when pkg-config might encounter anything that
isn't ascii, so it's hard for me to say what the right answer is.
>
> 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;
