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