A bit more pkg-config tweaks.
- I missed two anonymous subs.
- somehow I did mangle the flags with respect to --libs-only-other
- so I added regress tests for those.
- I found out that stuff like --libs-only-l will tend to prepend a space like
-lalpha2
turns out the glib2 version of pkg-config doesn't, so I fixed that (not
that hard to do, it's just a question of having do_libs return a proper list
with only existing elements)
- also found a warning message wrt -stable in the regress test
now, support for an extra suffix shouldn't be too hard. But seeing duplicate
code for suffixes handling made me cringe so much I had to fix it.
Please test :)
Hopefully the last iteration.
Index: regress/usr.bin/pkg-config/Makefile
===================================================================
RCS file: /cvs/src/regress/usr.bin/pkg-config/Makefile,v
retrieving revision 1.62
diff -u -p -r1.62 Makefile
--- regress/usr.bin/pkg-config/Makefile 15 Sep 2020 07:19:31 -0000 1.62
+++ regress/usr.bin/pkg-config/Makefile 5 Jun 2023 08:05:19 -0000
@@ -101,7 +101,12 @@ REGRESS_TARGETS=cmp-vers1-1 \
filter-system-dirs-5 \
filter-system-dirs-6 \
cflags-system-path-1 \
- cflags-system-path-2
+ cflags-system-path-2 \
+ lib-flags-1 \
+ lib-flags-2 \
+ lib-flags-3 \
+ lib-flags-4 \
+
PKG_CONFIG?= /usr/bin/pkg-config
PCONFIG = PKG_CONFIG_PATH=${.CURDIR}/pcdir/ ${PKG_CONFIG}
@@ -329,7 +334,7 @@ cmp-vers5-10:
cmp-vers6-1:
# Test suffixed versions in Requires
- @echo " -lalpha2" > ${WANT}
+ @echo "-lalpha2" > ${WANT}
@${VPCONFIG} --libs requires-test2
@diff -u ${WANT} ${GOT}
@@ -474,7 +479,7 @@ whitespace-libs:
whitespace-linebreak:
# Test linebreak in Description field
- @echo " -lc" > ${WANT}
+ @echo "-lc" > ${WANT}
@${VPCONFIG} --libs linebreak
@diff -u ${WANT} ${GOT}
@@ -631,19 +636,19 @@ variables-4:
variables-5:
# Test --variable
- @echo ' -lfoo-1' > ${WANT}
+ @echo '-lfoo-1' > ${WANT}
@${VPCONFIG} --libs variables
@diff -u ${WANT} ${GOT}
variables-6:
# Test variable overriding from environment
- @echo ' -lfoo-2' > ${WANT}
+ @echo '-lfoo-2' > ${WANT}
@PKG_CONFIG_VARIABLES_FOO_API_VERSION=2 ${VPCONFIG} --libs variables
@diff -u ${WANT} ${GOT}
variables-7:
# Ensure variable overriding only uses uppercase keys
- @echo ' -lfoo-1' > ${WANT}
+ @echo '-lfoo-1' > ${WANT}
@PKG_CONFIG_variables_foo_api_version=2 ${VPCONFIG} --libs variables
@diff -u ${WANT} ${GOT}
@@ -655,13 +660,13 @@ filter-system-dirs-1:
filter-system-dirs-2:
# Test removing -L/usr/lib as a system directory
- @echo ' -lfilter' > ${WANT}
+ @echo '-lfilter' > ${WANT}
@${VPCONFIG} --libs filter
@diff -u ${WANT} ${GOT}
filter-system-dirs-3:
# Test removing -L/usr/lib as a system directory (static)
- @echo ' -lfilter -lprivate-filter' > ${WANT}
+ @echo '-lfilter -lprivate-filter' > ${WANT}
@${VPCONFIG} --static --libs filter
@diff -u ${WANT} ${GOT}
@@ -697,6 +702,30 @@ cflags-system-path-2:
clean:
rm -f *.want *.got
+
+lib-flags-1:
+ # Test --libs-only-other
+ @echo "-pthread" > ${WANT}
+ @${VPCONFIG} --libs-only-other lib-flags
+ @diff -u ${WANT} ${GOT}
+
+lib-flags-2:
+ # Test --libs
+ @echo "-L/usr/local/lib -pthread -lalpha2" > ${WANT}
+ @${VPCONFIG} --libs lib-flags
+ @diff -u ${WANT} ${GOT}
+
+lib-flags-3:
+ # Test --libs-only-L
+ @echo "-L/usr/local/lib" > ${WANT}
+ @${VPCONFIG} --libs-only-L lib-flags
+ @diff -u ${WANT} ${GOT}
+
+lib-flags-4:
+ # Test --libs-only-l
+ @echo "-lalpha2" > ${WANT}
+ @${VPCONFIG} --libs-only-l lib-flags
+ @diff -u ${WANT} ${GOT}
.PHONY: ${REGRESS_TARGETS}
Index: regress/usr.bin/pkg-config/pcdir/lib-flags.pc
===================================================================
RCS file: regress/usr.bin/pkg-config/pcdir/lib-flags.pc
diff -N regress/usr.bin/pkg-config/pcdir/lib-flags.pc
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ regress/usr.bin/pkg-config/pcdir/lib-flags.pc 5 Jun 2023 08:05:19
-0000
@@ -0,0 +1,4 @@
+Name: lib separation test
+Description: pkg-config(1) regress file
+Version: 0.0
+Libs: -lalpha2 -L/usr/local/lib -pthread
Index: usr.bin/pkg-config/pkg-config
===================================================================
RCS file: /cvs/src/usr.bin/pkg-config/pkg-config,v
retrieving revision 1.95
diff -u -p -r1.95 pkg-config
--- usr.bin/pkg-config/pkg-config 15 Sep 2020 07:18:45 -0000 1.95
+++ usr.bin/pkg-config/pkg-config 5 Jun 2023 08:05:19 -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},
@@ -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 <<EOF
Usage: $0 [options]
@@ -655,9 +638,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,40 +652,39 @@ sub self_version
}
}
-sub compare
+sub parse_suffix($s)
{
- my ($a, $b) = @_;
- my ($full_a, $full_b) = ($a, $b);
- my (@suffix_a, @suffix_b);
-
- return 0 if ($a eq $b);
-
+ my @l = ();
+ my $full = $s;
# is there a valid non-numeric suffix to deal with later?
# accepted are (in order): a(lpha) < b(eta) < rc < ' '.
# suffix[0] is the 'alpha' part, suffix[1] is the '1' part in 'alpha1'.
- if ($a =~ s/(rc|beta|b|alpha|a)(\d+)$//) {
- say_debug("valid suffix $1$2 found in $a$1$2.");
- $suffix_a[0] = $1;
- $suffix_a[1] = $2;
+ if ($s =~ s/(rc|beta|b|alpha|a)(\d+)$//) {
+ @l = ($1, $2);
}
-
- if ($b =~ s/(rc|beta|b|alpha|a)(\d+)$//) {
- say_debug("valid suffix $1$2 found in $b$1$2.");
- $suffix_b[0] = $1;
- $suffix_b[1] = $2;
+ # also deal with -stable extension
+ elsif ($s =~ s/(\-stable)$//) {
+ @l = ($1);
}
-
# The above are standard suffixes; deal with single alphabetical
# suffixes too, e.g. 1.0.1h
- if ($a =~ s/([a-zA-Z]){1}$//) {
- say_debug("valid suffix $1 found in $a$1.");
- $suffix_a[0] = $1;
+ elsif ($s =~ s/([a-zA-Z]){1}$//) {
+ @l = ($1);
}
- if ($b =~ s/([a-zA-Z]){1}$//) {
- say_debug("valid suffix $1 found in $b$1.");
- $suffix_b[0] = $1;
- }
+ if (@l) {
+ say_debug("valid suffix @l found in $full.");
+ }
+
+ return ($s, @l);
+}
+
+sub compare($full_a, $full_b)
+{
+ return 0 if $full_a eq $full_b;
+
+ my ($a, @suffix_a) = parse_suffix($full_a);
+ my ($b, @suffix_b) = parse_suffix($full_b);
my @a = split(/\./, $a);
my @b = split(/\./, $b);
@@ -723,8 +704,8 @@ sub compare
# directly compare suffixes, provided both
suffixes
# are present.
if (@suffix_a && @suffix_b) {
- my $first_char = sub {
- return substr(shift, 0, 1);
+ my $first_char = sub($s) {
+ return substr($s, 0, 1);
};
# suffixes are equal, compare on numeric
@@ -769,10 +750,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 +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;
}
Index: usr.bin/pkg-config/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
--- usr.bin/pkg-config/OpenBSD/PkgConfig.pm 25 Jan 2023 19:06:50 -0000
1.9
+++ usr.bin/pkg-config/OpenBSD/PkgConfig.pm 5 Jun 2023 08:05:19 -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;
