Annotation of src/usr.bin/pkg-config/pkg-config, Revision 1.95
1.1 ckuethe 1: #!/usr/bin/perl
1.95 ! jasper 2: # $OpenBSD: pkg-config,v 1.94 2020/09/12 12:53:41 jasper Exp $
1.1 ckuethe 3:
4: # Copyright (c) 2006 Chris Kuethe <ckuethe@openbsd.org>
1.95 ! jasper 5: # Copyright (c) 2011-2020 Jasper Lievisse Adriaanse <jasper@openbsd.org>
1.1 ckuethe 6: #
7: # Permission to use, copy, modify, and distribute this software for any
8: # purpose with or without fee is hereby granted, provided that the above
9: # copyright notice and this permission notice appear in all copies.
10: #
11: # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12: # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13: # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14: # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15: # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16: # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17: # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18:
19: use strict;
20: use warnings;
1.70 jasper 21: use Config;
1.1 ckuethe 22: use Getopt::Long;
1.4 espie 23: use File::Basename;
1.58 jasper 24: use File::stat;
1.11 espie 25: use OpenBSD::PkgConfig;
1.1 ckuethe 26:
1.71 ajacouto 27: my @PKGPATH = qw(/usr/lib/pkgconfig
28: /usr/local/lib/pkgconfig
29: /usr/local/share/pkgconfig
30: /usr/X11R6/lib/pkgconfig
31: /usr/X11R6/share/pkgconfig);
1.1 ckuethe 32:
1.16 espie 33: if (defined($ENV{PKG_CONFIG_LIBDIR}) && $ENV{PKG_CONFIG_LIBDIR}) {
1.66 jasper 34: @PKGPATH = split(/:/, $ENV{PKG_CONFIG_LIBDIR});
1.16 espie 35: } elsif (defined($ENV{PKG_CONFIG_PATH}) && $ENV{PKG_CONFIG_PATH}) {
1.66 jasper 36: unshift(@PKGPATH, split(/:/, $ENV{PKG_CONFIG_PATH}));
1.1 ckuethe 37: }
38:
39: my $logfile = '';
1.50 jasper 40: if (defined($ENV{PKG_CONFIG_LOG}) && $ENV{PKG_CONFIG_LOG}) {
41: $logfile = $ENV{PKG_CONFIG_LOG};
1.1 ckuethe 42: }
43:
1.33 jasper 44: my $allow_uninstalled =
1.16 espie 45: defined $ENV{PKG_CONFIG_DISABLE_UNINSTALLED} ? 0 : 1;
1.14 espie 46: my $found_uninstalled = 0;
47:
1.95 ! jasper 48: my $version = '0.29.2'; # pretend to be this version of pkgconfig
1.10 espie 49:
50: my %configs = ();
1.35 espie 51: setup_self();
52:
1.10 espie 53: my %mode = ();
1.11 espie 54: my $variables = {};
1.1 ckuethe 55:
1.56 jasper 56: $variables->{pc_top_builddir} = $ENV{PKG_CONFIG_TOP_BUILD_DIR} //
1.35 espie 57: '$(top_builddir)';
58:
59: $variables->{pc_sysrootdir} //= $ENV{PKG_CONFIG_SYSROOT_DIR};
60: # The default '/' is implied.
1.29 jasper 61:
1.95 ! jasper 62: my @sys_includes = ('/usr/include');
! 63: foreach my $path ($ENV{PKG_CONFIG_SYSTEM_INCLUDE_PATH}, $ENV{C_PATH}, $ENV{C_INCLUDE_PATH},
! 64: $ENV{CPLUS_INCLUDE_PATH}) {
! 65: next if !defined($path);
! 66: unshift(@sys_includes, split(/:/, $path));
! 67: }
! 68:
1.61 jasper 69: defined $ENV{PKG_CONFIG_DEBUG_SPEW} ? $mode{debug} = 1 : $mode{debug} = 0;
1.7 ckuethe 70:
1.4 espie 71: if ($logfile) {
1.35 espie 72: open my $L, ">>" , $logfile or die;
1.51 jasper 73: print $L beautify_list($0, @ARGV), "\n";
1.4 espie 74: close $L;
1.1 ckuethe 75: }
76:
77: # combo arg-parsing and dependency resolution loop. Hopefully when the loop
78: # terminates, we have a full list of packages upon which we depend, and the
79: # right set of compiler and linker flags to use them.
80: #
81: # as each .pc file is loaded, it is stored in %configs, indexed by package
82: # name. this makes it possible to then pull out flags or do substitutions
1.34 jasper 83: # without having to go back and reload the files from disk.
1.1 ckuethe 84:
85: Getopt::Long::Configure('no_ignore_case');
1.68 jasper 86: GetOptions( 'debug' => \$mode{debug},
87: 'help' => \&help, #does not return
88: 'usage' => \&help, #does not return
89: 'list-all' => \$mode{list},
90: 'version' => sub { print "$version\n" ; exit(0);} ,
91: 'errors-to-stdout' => sub { $mode{estdout} = 1},
92: 'print-errors' => sub { $mode{printerr} = 1},
93: 'silence-errors' => sub { $mode{printerr} = 0},
94: 'short-errors' => sub { $mode{printerr} = 0},
1.14 espie 95: 'atleast-pkgconfig-version=s' => \$mode{myminvers},
1.68 jasper 96: 'print-provides' => \$mode{printprovides},
97: 'print-requires' => \$mode{printrequires},
1.30 jasper 98: 'print-requires-private' => \$mode{printrequiresprivate},
1.11 espie 99:
1.68 jasper 100: 'cflags' => sub { $mode{cflags} = 3},
101: 'cflags-only-I' => sub { $mode{cflags} |= 1},
102: 'cflags-only-other' => sub { $mode{cflags} |= 2},
103: 'libs' => sub { $mode{libs} = 7},
104: 'libs-only-l' => sub { $mode{libs} |= 1},
105: 'libs-only-L' => sub { $mode{libs} |= 2},
106: 'libs-only-other' => sub { $mode{libs} |= 4},
107: 'exists' => sub { $mode{exists} = 1} ,
1.91 jasper 108: 'validate' => sub { $mode{validate} = 1},
1.68 jasper 109: 'static' => sub { $mode{static} = 1},
110: 'uninstalled' => sub { $mode{uninstalled} = 1},
111: 'atleast-version=s' => \$mode{minversion},
112: 'exact-version=s' => \$mode{exactversion},
113: 'max-version=s' => \$mode{maxversion},
114: 'modversion' => \$mode{modversion},
115: 'variable=s' => \$mode{variable},
116: 'define-variable=s' => $variables,
1.1 ckuethe 117: );
118:
1.70 jasper 119: # Unconditionally switch to static mode on static arches as --static
120: # may not have been passed explicitly, but we don't want to re-order
121: # and simplify the libs like we do for shared architectures.
122: {
1.88 jasper 123: my @static_archs = qw();
1.70 jasper 124: my $machine_arch = $Config{'ARCH'};
125: if (grep { $_ eq $machine_arch } @static_archs){
126: $mode{static} = 1;
127: }
128: }
129:
1.14 espie 130: # Initial value of printerr depends on the options...
131: if (!defined $mode{printerr}) {
1.61 jasper 132: if (defined $mode{libs}
133: or defined $mode{cflags}
134: or defined $mode{version}
1.91 jasper 135: or defined $mode{list}
136: or defined $mode{validate}) {
1.14 espie 137: $mode{printerr} = 1;
138: } else {
139: $mode{printerr} = 0;
140: }
141: }
142:
1.62 jasper 143: say_debug("\n" . beautify_list($0, @ARGV));
1.13 espie 144:
145: my $rc = 0;
1.1 ckuethe 146:
1.14 espie 147: # XXX pkg-config is a bit weird
1.10 espie 148: {
149: my $p = join(' ', @ARGV);
1.14 espie 150: $p =~ s/^\s+//;
1.66 jasper 151: @ARGV = split(/\,?\s+/, $p);
1.10 espie 152: }
1.1 ckuethe 153:
1.14 espie 154: if ($mode{myminvers}) {
155: exit self_version($mode{myminvers});
156: }
157:
158: if ($mode{list}) {
159: exit do_list();
1.1 ckuethe 160: }
161:
1.13 espie 162: my $cfg_full_list = [];
1.14 espie 163: my $top_config = [];
1.73 jasper 164:
165: # When we got here we're supposed to have had at least one
166: # package as argument.
167: if (!@ARGV){
168: say_error("No package name(s) specified.");
169: exit 1;
170: }
1.1 ckuethe 171:
1.86 jasper 172: # Return the next module from @ARGV, if it turns out to be a comma separated
173: # module list, take the first one and put the rest back to the front.
1.94 jasper 174: sub get_next_module
1.93 espie 175: {
1.86 jasper 176: my $module = shift @ARGV;
177: my $m;
178: if ($module =~ m/,/) {
179: my @ms = split(/,/, $module);
180: $m = shift @ms;
181: unshift(@ARGV, @ms) if (scalar(@ms) > 0);
182: } else {
183: return $module;
184: }
185:
186: return $m;
187: }
188:
1.1 ckuethe 189: while (@ARGV){
1.86 jasper 190: my $p = get_next_module();
1.13 espie 191: my $op = undef;
192: my $v = undef;
1.85 jca 193: if (@ARGV >= 2 && $ARGV[0] =~ /^[<=>!]+$/ &&
1.59 jasper 194: $ARGV[1] =~ /^[\d\.]+[\w\.]*$/) {
1.13 espie 195: $op = shift @ARGV;
196: $v = shift @ARGV;
1.1 ckuethe 197: }
1.52 jasper 198: # For these modes we just need some meta-information and
199: # parsing the requirements is not needed.
200: if (!($mode{modversion} || $mode{printprovides})) {
201: handle_config($p, $op, $v, $cfg_full_list);
202: }
1.14 espie 203: push(@$top_config, $p);
204: }
205:
1.91 jasper 206: if ($mode{exists} || $mode{validate}) {
1.14 espie 207: exit $rc;
208: }
209:
210: if ($mode{uninstalled}) {
211: $rc = 1 unless $found_uninstalled;
212: exit $rc;
1.11 espie 213: }
1.1 ckuethe 214:
1.30 jasper 215: if ($mode{modversion} || $mode{printprovides}) {
1.14 espie 216: for my $pkg (@$top_config) {
217: do_modversion($pkg);
218: }
219: }
1.13 espie 220:
1.30 jasper 221: if ($mode{printrequires} || $mode{printrequiresprivate}) {
222: for my $pkg (@$top_config) {
223: print_requires($pkg);
224: }
225: }
226:
1.14 espie 227: if ($mode{minversion}) {
228: my $v = $mode{minversion};
229: for my $pkg (@$top_config) {
230: $rc = 1 unless versionmatch($configs{$pkg}, '>=', $v);
231: }
232: exit $rc;
233: }
234:
235: if ($mode{exactversion}) {
236: my $v = $mode{exactversion};
237: for my $pkg (@$top_config) {
238: $rc = 1 unless versionmatch($configs{$pkg}, '=', $v);
239: }
240: exit $rc;
241: }
242:
1.76 jasper 243: if ($mode{maxversion}) {
1.14 espie 244: my $v = $mode{maxversion};
245: for my $pkg (@$top_config) {
246: $rc = 1 unless versionmatch($configs{$pkg}, '<=', $v);
247: }
248: exit $rc;
249: }
250:
251: my @vlist = ();
252:
253: if ($mode{variable}) {
254: for my $pkg (@$top_config) {
255: do_variable($pkg, $mode{variable});
256: }
257: }
258:
1.70 jasper 259: my $dep_cfg_list = $cfg_full_list;
260:
1.72 espie 261: if ($mode{static}){
262: $dep_cfg_list = [reverse(@$cfg_full_list)];
263: } else {
1.70 jasper 264: $dep_cfg_list = simplify_and_reverse($cfg_full_list);
265: }
1.14 espie 266:
267: if ($mode{cflags} || $mode{libs} || $mode{variable}) {
1.66 jasper 268: push @vlist, do_cflags($dep_cfg_list) if $mode{cflags};
269: push @vlist, do_libs($dep_cfg_list) if $mode{libs};
270: print join(' ', @vlist), "\n" if $rc == 0;
1.1 ckuethe 271: }
272:
1.13 espie 273: exit $rc;
1.1 ckuethe 274:
275: ###########################################################################
276:
1.11 espie 277: sub handle_config
278: {
1.13 espie 279: my ($p, $op, $v, $list) = @_;
1.35 espie 280: my $cfg = cache_find_config($p);
1.13 espie 281:
1.35 espie 282: unshift @$list, $p if defined $cfg;
1.11 espie 283:
1.35 espie 284: if (!defined $cfg) {
285: $rc = 1;
286: return undef;
287: }
1.15 espie 288:
1.35 espie 289: if (defined $op) {
290: if (!versionmatch($cfg, $op, $v)) {
291: mismatch($p, $cfg, $op, $v) if $mode{printerr};
1.13 espie 292: $rc = 1;
293: return undef;
294: }
1.35 espie 295: }
1.11 espie 296:
1.43 jasper 297: my $get_props = sub {
1.93 espie 298: my $property = shift;
299: my $pkg;
1.43 jasper 300:
1.94 jasper 301: # See if there's anything in the environment that we need to
1.93 espie 302: # take into account.
303: ($pkg = $p) =~ s/(^.*\/)?(.*?)\.pc$/$2/g;
304: $pkg = uc($pkg);
305:
306: if (grep {/PKG_CONFIG_${pkg}.*/} keys %ENV) {
1.94 jasper 307: # Now that we know we have something to look for, do
1.93 espie 308: # the inefficient iteration.
309: while (my ($k, $v) = each %ENV) {
310: if ($k =~ /^PKG_CONFIG_${pkg}_(\w+)/) {
311: $variables->{lc($1)} = $v;
312: }
313: }
314: }
315:
316: my $deps = $cfg->get_property($property, $variables);
317: return unless defined $deps;
318: for my $dep (@$deps) {
319: if ($dep =~ m/^(.*?)\s*([<=>]+)\s*([\d\.]+|[\d\.]+[\w]*[\d]+)$/) {
320: handle_config($1, $2, $3, $list);
321: } else {
322: handle_config($dep, undef, undef, $list);
323: }
324: }
325: say_debug("package $p " . lc($property) . " " . join(',', @$deps));
1.43 jasper 326: };
327:
1.66 jasper 328: if (defined $mode{cflags}
329: or ($mode{static} && $mode{libs})
1.74 jasper 330: or $mode{printrequiresprivate}
331: or $mode{exists}) {
1.64 jasper 332: &$get_props("Requires.private");
333: }
1.91 jasper 334:
335: unless (defined $mode{validate}) {
336: &$get_props("Requires");
337: }
1.11 espie 338: }
339:
1.1 ckuethe 340: # look for the .pc file in each of the PKGPATH elements. Return the path or
341: # undef if it's not there
1.4 espie 342: sub pathresolve
343: {
344: my ($p) = @_;
345:
1.14 espie 346: if ($allow_uninstalled && $p !~ m/\-uninstalled$/) {
1.93 espie 347: for my $d (@PKGPATH) {
1.14 espie 348: my $f = "$d/$p-uninstalled.pc";
1.62 jasper 349: say_debug("pathresolve($p) looking in $f");
1.14 espie 350: if (-f $f) {
351: $found_uninstalled = 1;
352: return $f;
353: }
354: }
355: }
356:
1.93 espie 357: for my $d (@PKGPATH) {
1.10 espie 358: my $f = "$d/$p.pc";
1.62 jasper 359: say_debug("pathresolve($p) looking in $f");
1.10 espie 360: return $f if -f $f;
1.1 ckuethe 361: }
1.10 espie 362: return undef;
1.1 ckuethe 363: }
364:
1.11 espie 365: sub get_config
366: {
367: my ($f) = @_;
368:
369: my $cfg;
1.33 jasper 370: eval {
1.11 espie 371: $cfg = OpenBSD::PkgConfig->read_file($f);
372: };
373: if (!$@) {
1.37 jasper 374: return validate_config($f, $cfg);
1.11 espie 375: } else {
1.62 jasper 376: say_debug($@);
1.11 espie 377: }
378: return undef;
379: }
380:
1.13 espie 381: sub cache_find_config
382: {
383: my $name = shift;
384:
1.62 jasper 385: say_debug("processing $name");
1.13 espie 386:
387: if (exists $configs{$name}) {
388: return $configs{$name};
389: } else {
390: return $configs{$name} = find_config($name);
391: }
1.37 jasper 392: }
393:
394: # Required elements for a valid .pc file: Name, Description, Version
395: sub validate_config
396: {
397: my ($f, $cfg) = @_;
398: my @required_elems = ('Name', 'Description', 'Version');
1.58 jasper 399:
400: # Check if we're dealing with an empty file, but don't error out just
401: # yet, we'll do that when we realize there's no Name field.
1.61 jasper 402: if (stat($f)->size == 0) {
1.80 jasper 403: say_error("Package file '$f' appears to be empty");
1.58 jasper 404: }
1.37 jasper 405:
1.93 espie 406: for my $p (@required_elems) {
407: my $e = $cfg->get_property($p, $variables);
1.37 jasper 408: if (!defined $e) {
1.91 jasper 409: $f =~ s/(^.*\/)?(.*?)\.pc$/$2/g;
1.93 espie 410: say_error("Package '$f' has no $p: field");
1.37 jasper 411: return undef;
412: }
413: }
414:
415: return $cfg;
1.13 espie 416: }
417:
1.35 espie 418: # pkg-config won't install a pkg-config.pc file itself, but it may be
1.63 jasper 419: # listed as a dependency in other files. so prime the cache with self.
1.35 espie 420: sub setup_self
421: {
422: my $pkg_pc = OpenBSD::PkgConfig->new;
423: $pkg_pc->add_property('Version', $version);
1.38 jasper 424: $pkg_pc->add_variable('pc_path', join(":", @PKGPATH));
1.87 tb 425: $pkg_pc->add_property('URL', "http://man.openbsd.org/pkg-config");
1.63 jasper 426: $pkg_pc->add_property('Description', "fetch metadata about installed software packages");
1.35 espie 427: $configs{'pkg-config'} = $pkg_pc;
428: }
429:
1.11 espie 430: sub find_config
431: {
432: my ($p) = @_;
1.78 jasper 433:
434: # Differentiate between getting a full path and just the module name.
435: my $f = ($p =~ m/\.pc$/ ? $p : pathresolve($p));
1.64 jasper 436:
437: return get_config($f) if defined($f);
438:
1.62 jasper 439: say_error("Package $p was not found in the pkg-config search path");
1.61 jasper 440:
1.11 espie 441: return undef;
442: }
1.1 ckuethe 443:
1.11 espie 444: sub stringize
1.4 espie 445: {
1.11 espie 446: my $list = shift;
1.21 simon 447: my $sep = shift || ',';
1.4 espie 448:
1.11 espie 449: if (defined $list) {
1.21 simon 450: return join($sep, @$list)
1.11 espie 451: } else {
452: return '';
1.1 ckuethe 453: }
454: }
455:
456: #if the variable option is set, pull out the named variable
1.4 espie 457: sub do_variable
458: {
1.11 espie 459: my ($p, $v) = @_;
1.1 ckuethe 460:
1.13 espie 461: my $cfg = cache_find_config($p);
462:
463: if (defined $cfg) {
1.11 espie 464: my $value = $cfg->get_variable($v, $variables);
465: if (defined $value) {
1.13 espie 466: push(@vlist, $value);
1.11 espie 467: }
1.19 espie 468: return undef;
1.11 espie 469: }
1.19 espie 470: $rc = 1;
1.1 ckuethe 471: }
472:
1.30 jasper 473: #if the modversion or print-provides options are set,
474: #pull out the compiler flags
1.4 espie 475: sub do_modversion
476: {
1.11 espie 477: my ($p) = @_;
1.1 ckuethe 478:
1.13 espie 479: my $cfg = cache_find_config($p);
480:
481: if (defined $cfg) {
1.11 espie 482: my $value = $cfg->get_property('Version', $variables);
483: if (defined $value) {
1.60 jasper 484: if (defined($mode{printprovides})){
485: print "$p = " . stringize($value) . "\n";
1.30 jasper 486: return undef;
487: } else {
1.60 jasper 488: print stringize($value), "\n";
1.30 jasper 489: return undef;
490: }
1.11 espie 491: }
492: }
1.13 espie 493: $rc = 1;
1.1 ckuethe 494: }
495:
496: #if the cflags option is set, pull out the compiler flags
1.4 espie 497: sub do_cflags
498: {
1.14 espie 499: my $list = shift;
500:
1.11 espie 501: my $cflags = [];
1.1 ckuethe 502:
1.93 espie 503: for my $pkg (@$list) {
1.11 espie 504: my $l = $configs{$pkg}->get_property('Cflags', $variables);
1.95 ! jasper 505: PATH: for my $path (@$l) {
! 506: for my $sys_path (@sys_includes) {
! 507: next PATH if ($path =~ /${sys_path}\/*$/);
1.89 jasper 508: }
1.95 ! jasper 509: push(@$cflags, $path);
1.89 jasper 510: }
1.11 espie 511: }
1.32 jasper 512: my $a = OpenBSD::PkgConfig->compress($cflags,
1.11 espie 513: sub {
514: local $_ = shift;
515: if (($mode{cflags} & 1) && /^-I/ ||
516: ($mode{cflags} & 2) && !/^-I/) {
517: return 1;
518: } else {
519: return 0;
1.4 espie 520: }
1.11 espie 521: });
1.32 jasper 522: if (defined($a) && defined($variables->{pc_sysrootdir})){
1.36 jasper 523: $a =~ s/[\w]?-I/$&$variables->{pc_sysrootdir}/g;
1.32 jasper 524: }
525:
526: return $a;
1.1 ckuethe 527: }
528:
529: #if the lib option is set, pull out the linker flags
1.4 espie 530: sub do_libs
531: {
1.14 espie 532: my $list = shift;
533:
1.11 espie 534: my $libs = [];
1.1 ckuethe 535:
1.68 jasper 536: # In static mode, we have to make sure we discover the libs in dependency
537: # order, not in search order. Ordering matters for static linking:
538: # Start with Libs (first our own, then dependencies), and append
539: # Libs.private (same order as for Libs).
1.93 espie 540: for my $pkg (@$list) {
1.11 espie 541: my $l = $configs{$pkg}->get_property('Libs', $variables);
1.93 espie 542: for my $path (@$l) {
543: unless ($path =~ /-L\/usr\/lib\/*$/) {
544: push(@$libs, $path);
1.89 jasper 545: }
546: }
1.67 jasper 547: if ($mode{static}) {
548: my $lp = $configs{$pkg}->get_property('Libs.private', $variables);
1.93 espie 549: for my $path (@$lp) {
550: unless ($path =~ /-L\/usr\/lib\/*/) {
551: push(@$libs, $path);
1.89 jasper 552: }
553: }
1.67 jasper 554: }
1.11 espie 555: }
1.66 jasper 556:
1.68 jasper 557: # Get the linker path directives (-L) and store it in $a.
558: # $b will be the actual libraries.
1.13 espie 559: my $a = OpenBSD::PkgConfig->compress($libs,
1.93 espie 560: sub {
561: local $_ = shift;
562: if (($mode{libs} & 2) && /^-L/ ||
563: ($mode{libs} & 4) && !/^-[lL]/) {
564: return 1;
565: } else {
566: return 0;
567: }
568: });
1.32 jasper 569:
570: if (defined($variables->{pc_sysrootdir})){
1.36 jasper 571: $a =~ s/[\w]?-[lL]/$&$variables->{pc_sysrootdir}/g;
1.32 jasper 572: }
573:
1.13 espie 574: if ($mode{libs} & 1) {
575: my $b = OpenBSD::PkgConfig->rcompress($libs,
1.93 espie 576: sub { shift =~ m/^-l/; });
1.13 espie 577: return ($a, $b);
578: } else {
579: return $a;
580: }
1.1 ckuethe 581: }
582:
583: #list all packages
1.4 espie 584: sub do_list
585: {
1.1 ckuethe 586: my ($p, $x, $y, @files, $fname, $name);
1.20 espie 587: my $error = 0;
588:
1.93 espie 589: for my $p (@PKGPATH) {
1.33 jasper 590: push(@files, <$p/*.pc>);
1.4 espie 591: }
1.1 ckuethe 592:
593: # Scan the lengths of the package names so I can make a format
594: # string to line the list up just like the real pkgconfig does.
595: $x = 0;
1.93 espie 596: for my $f (@files) {
1.4 espie 597: $fname = basename($f, '.pc');
598: $y = length $fname;
1.1 ckuethe 599: $x = (($y > $x) ? $y : $x);
600: }
601: $x *= -1;
602:
1.93 espie 603: for my $f (@files) {
1.11 espie 604: my $cfg = get_config($f);
1.20 espie 605: if (!defined $cfg) {
1.62 jasper 606: say_warning("Problem reading file $f");
1.20 espie 607: $error = 1;
608: next;
609: }
1.4 espie 610: $fname = basename($f, '.pc');
1.33 jasper 611: printf("%${x}s %s - %s\n", $fname,
1.53 jasper 612: stringize($cfg->get_property('Name', $variables), ' '),
1.21 simon 613: stringize($cfg->get_property('Description', $variables),
614: ' '));
1.1 ckuethe 615: }
1.20 espie 616: return $error;
1.1 ckuethe 617: }
618:
1.4 espie 619: sub help
620: {
1.1 ckuethe 621: print <<EOF
622: Usage: $0 [options]
623: --debug - turn on debugging output
624: --help - this message
625: --usage - this message
626: --list-all - show all packages that $0 can find
1.8 ckuethe 627: --version - print version of pkgconfig
628: --errors-to-stdout - direct error messages to stdout rather than stderr
629: --print-errors - print error messages in case of error
1.34 jasper 630: --print-provides - print all the modules the given package provides
631: --print-requires - print all the modules the given package requires
632: --print-requires-private - print all the private modules the given package requires
1.66 jasper 633: --silence-errors - don\'t print error messages in case of error
1.1 ckuethe 634: --atleast-pkgconfig-version [version] - require a certain version of pkgconfig
635: --cflags package [versionspec] [package [versionspec]]
636: --cflags-only-I - only output -Iincludepath flags
637: --cflags-only-other - only output flags that are not -I
1.11 espie 638: --define-variable=NAME=VALUE - define variables
1.1 ckuethe 639: --libs package [versionspec] [package [versionspec]]
640: --libs-only-l - only output -llib flags
641: --libs-only-L - only output -Llibpath flags
642: --libs-only-other - only output flags that are not -l or -L
643: --exists package [versionspec] [package [versionspec]]
1.91 jasper 644: --validate package
1.1 ckuethe 645: --uninstalled - allow for uninstalled versions to be used
1.8 ckuethe 646: --static - adjust output for static linking
647: --atleast-version [version] - require a certain version of a package
1.77 jasper 648: --exact-version [version] - require exactly the specified version of a package
649: --max-version [version] - require at most a certain version of a package
1.8 ckuethe 650: --modversion [package] - query the version of a package
651: --variable var package - return the definition of <var> in <package>
1.1 ckuethe 652: EOF
653: ;
1.22 simon 654: exit 0;
1.1 ckuethe 655: }
656:
657: # do we meet/beat the version the caller requested?
1.4 espie 658: sub self_version
659: {
660: my ($v) = @_;
661: my (@a, @b);
662:
1.66 jasper 663: @a = split(/\./, $v);
664: @b = split(/\./, $version);
1.1 ckuethe 665:
1.4 espie 666: if (($b[0] >= $a[0]) && ($b[1] >= $a[1])) {
1.14 espie 667: return 0;
1.1 ckuethe 668: } else {
1.14 espie 669: return 1;
670: }
671: }
672:
673: sub compare
674: {
675: my ($a, $b) = @_;
1.46 jasper 676: my ($full_a, $full_b) = ($a, $b);
677: my (@suffix_a, @suffix_b);
1.14 espie 678:
1.28 jasper 679: return 0 if ($a eq $b);
1.14 espie 680:
1.46 jasper 681: # is there a valid non-numeric suffix to deal with later?
1.58 jasper 682: # accepted are (in order): a(lpha) < b(eta) < rc < ' '.
1.46 jasper 683: # suffix[0] is the 'alpha' part, suffix[1] is the '1' part in 'alpha1'.
1.59 jasper 684: if ($a =~ s/(rc|beta|b|alpha|a)(\d+)$//) {
1.62 jasper 685: say_debug("valid suffix $1$2 found in $a$1$2.");
1.46 jasper 686: $suffix_a[0] = $1;
687: $suffix_a[1] = $2;
688: }
689:
1.59 jasper 690: if ($b =~ s/(rc|beta|b|alpha|a)(\d+)$//) {
1.62 jasper 691: say_debug("valid suffix $1$2 found in $b$1$2.");
1.46 jasper 692: $suffix_b[0] = $1;
693: $suffix_b[1] = $2;
1.82 jasper 694: }
695:
696: # The above are standard suffixes; deal with single alphabetical
697: # suffixes too, e.g. 1.0.1h
698: if ($a =~ s/([a-zA-Z]){1}$//) {
699: say_debug("valid suffix $1 found in $a$1.");
700: $suffix_a[0] = $1;
701: }
702:
703: if ($b =~ s/([a-zA-Z]){1}$//) {
704: say_debug("valid suffix $1 found in $b$1.");
705: $suffix_b[0] = $1;
1.46 jasper 706: }
707:
1.66 jasper 708: my @a = split(/\./, $a);
709: my @b = split(/\./, $b);
1.14 espie 710:
711: while (@a && @b) { #so long as both lists have something
1.46 jasper 712: if (!(@suffix_a || @suffix_b)) {
713: # simple comparison when no suffixes are in the game.
1.48 jasper 714: my $rc = compare_numeric($a[0], $b[0], 0);
715: return $rc if defined($rc);
1.46 jasper 716: } else {
717: # extended comparison.
1.56 jasper 718: if (((@a == 1) || (@b == 1)) &&
1.46 jasper 719: ($a[0] == $b[0])){
720: # one of the arrays has reached the last element,
721: # compare the suffix.
722:
723: # directly compare suffixes, provided both suffixes
724: # are present.
725: if (@suffix_a && @suffix_b) {
726: my $first_char = sub {
727: return substr(shift, 0, 1);
728: };
729:
730: # suffixes are equal, compare on numeric
731: if (&$first_char($suffix_a[0]) eq
732: &$first_char($suffix_b[0])) {
1.48 jasper 733: return compare_numeric($suffix_a[1], $suffix_b[1], 1);
1.46 jasper 734: }
735:
1.47 jasper 736: # rc beats beta beats alpha
1.46 jasper 737: if (&$first_char($suffix_a[0]) lt &$first_char($suffix_b[0])) {
1.62 jasper 738: say_debug("$full_a (installed) < $full_b (wanted)");
1.46 jasper 739: return -1;
740: } else {
1.62 jasper 741: say_debug("$full_a (installed) > $full_b (wanted)");
1.46 jasper 742: return 1;
743: }
744:
745: } else {
746: # one of either is lacking a suffix,
747: # thereby beating the other.
748: # e.g.: 1.02 > 1.02b1
749: if (@suffix_a) { # a is older
1.62 jasper 750: say_debug("$full_a (installed) < $full_b (wanted)");
1.55 jasper 751: return 1;
1.46 jasper 752: }
753:
754: if (@suffix_b) { # b is older
1.62 jasper 755: say_debug("$full_a (installed) > $full_b (wanted)");
1.55 jasper 756: return -1;
1.46 jasper 757: }
758: }
759: } else {
1.48 jasper 760: my $rc = compare_numeric($a[0], $b[0], 0);
761: return $rc if defined($rc);
1.46 jasper 762: }
763: }
1.14 espie 764: shift @a; shift @b;
765: }
766: return 1 if @a;
767: return -1 if @b;
768: return 0;
1.48 jasper 769: }
770:
771: # simple numeric comparison, with optional equality test.
772: sub compare_numeric
773: {
774: my ($x, $y, $eq) = @_;
775:
1.81 jasper 776: return 1 if $x > $y;
1.48 jasper 777: return -1 if $x < $y;
1.81 jasper 778: return 0 if (($x == $y) and ($eq == 1));
1.48 jasper 779: return undef;
1.1 ckuethe 780: }
781:
782: # got a package meeting the requested specific version?
1.4 espie 783: sub versionmatch
784: {
1.14 espie 785: my ($cfg, $op, $want) = @_;
1.33 jasper 786:
1.1 ckuethe 787: # can't possibly match if we can't find the file
1.11 espie 788: return 0 if !defined $cfg;
789:
1.14 espie 790: my $inst = stringize($cfg->get_property('Version', $variables));
1.11 espie 791:
1.1 ckuethe 792: # can't possibly match if we can't find the version string
1.14 espie 793: return 0 if $inst eq '';
1.1 ckuethe 794:
1.62 jasper 795: say_debug("comparing $want (wanted) to $inst (installed)");
1.14 espie 796: my $value = compare($inst, $want);
1.31 jasper 797: if ($op eq '>=') { return $value >= 0; }
798: elsif ($op eq '=') { return $value == 0; }
799: elsif ($op eq '!=') { return $value != 0; }
800: elsif ($op eq '<') { return $value < 0; }
801: elsif ($op eq '>') { return $value > 0; }
802: elsif ($op eq '<=') { return $value <= 0; }
1.13 espie 803: }
804:
805: sub mismatch
806: {
807: my ($p, $cfg, $op, $v) = @_;
1.53 jasper 808: my $name = stringize($cfg->get_property('Name'), ' ');
1.41 jasper 809: my $version = stringize($cfg->get_property('Version'));
810: my $url = stringize($cfg->get_property('URL'));
811:
1.62 jasper 812: say_warning("Requested '$p $op $v' but version of $name is $version");
813: say_warning("You may find new versions of $name at $url") if $url;
1.13 espie 814: }
815:
816: sub simplify_and_reverse
817: {
818: my $reqlist = shift;
819: my $dejavu = {};
820: my $result = [];
821:
822: for my $item (@$reqlist) {
823: if (!$dejavu->{$item}) {
824: unshift @$result, $item;
825: $dejavu->{$item} = 1;
826: }
827: }
828: return $result;
1.30 jasper 829: }
830:
831: # retrieve and print Requires(.private)
832: sub print_requires
833: {
834: my ($p) = @_;
835:
836: my $cfg = cache_find_config($p);
837:
838: if (defined($cfg)) {
839: my $value;
840:
841: if (defined($mode{printrequires})) {
842: $value = $cfg->get_property('Requires', $variables);
843: } elsif (defined($mode{printrequiresprivate})) {
844: $value = $cfg->get_property('Requires.private', $variables);
845: } else {
1.62 jasper 846: say_debug("Unknown mode for print_requires.");
1.30 jasper 847: return 1;
848: }
849:
850: if (defined($value)) {
1.93 espie 851: print "$_\n" for @$value;
1.30 jasper 852: return undef;
853: }
854: }
855:
856: $rc = 1;
1.35 espie 857: }
858:
859: sub beautify_list
860: {
861: return join(' ', map {"[$_]"} @_);
1.61 jasper 862: }
863:
1.62 jasper 864: sub say_debug
1.61 jasper 865: {
1.62 jasper 866: say_msg(shift) if $mode{debug};
1.61 jasper 867: }
868:
1.62 jasper 869: sub say_error
1.61 jasper 870: {
1.62 jasper 871: say_msg(shift) if $mode{printerr}
872: }
873:
874: sub say_warning
875: {
876: say_msg(shift);
877: }
878:
879: sub say_msg
880: {
1.63 jasper 881: my $str = shift;
1.62 jasper 882:
883: # If --errors-to-stdout was given, close STDERR (to be safe),
884: # then dup the output to STDOUT and delete the key from %mode so we
885: # won't keep checking it. STDERR stays dup'ed.
886: if ($mode{estdout}) {
887: close(STDERR);
888: open(STDERR, ">&STDOUT") or die "Can't dup STDOUT: $!";
889: delete($mode{estdout});
890: }
891:
1.93 espie 892: print STDERR $str, "\n";
1.1 ckuethe 893: }