Annotation of src/usr.bin/pkg-config/pkg-config, Revision 1.79
1.1 ckuethe 1: #!/usr/bin/perl
1.79 ! brad 2: # $OpenBSD: pkg-config,v 1.78 2013/03/28 22:00:02 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.40 jasper 6: # Copyright (c) 2011 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.75 jasper 49: my $version = '0.27.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} ,
102: 'static' => sub { $mode{static} = 1},
103: 'uninstalled' => sub { $mode{uninstalled} = 1},
104: 'atleast-version=s' => \$mode{minversion},
105: 'exact-version=s' => \$mode{exactversion},
106: 'max-version=s' => \$mode{maxversion},
107: 'modversion' => \$mode{modversion},
108: 'variable=s' => \$mode{variable},
109: 'define-variable=s' => $variables,
1.1 ckuethe 110: );
111:
1.70 jasper 112: # Unconditionally switch to static mode on static arches as --static
113: # may not have been passed explicitly, but we don't want to re-order
114: # and simplify the libs like we do for shared architectures.
115: {
1.79 ! brad 116: my @static_archs = qw(vax);
1.70 jasper 117: my $machine_arch = $Config{'ARCH'};
118: if (grep { $_ eq $machine_arch } @static_archs){
119: $mode{static} = 1;
120: }
121: }
122:
1.14 espie 123: # Initial value of printerr depends on the options...
124: if (!defined $mode{printerr}) {
1.61 jasper 125: if (defined $mode{libs}
126: or defined $mode{cflags}
127: or defined $mode{version}
128: or defined $mode{list}) {
1.14 espie 129: $mode{printerr} = 1;
130: } else {
131: $mode{printerr} = 0;
132: }
133: }
134:
1.62 jasper 135: say_debug("\n" . beautify_list($0, @ARGV));
1.13 espie 136:
137: my $rc = 0;
1.1 ckuethe 138:
1.14 espie 139: # XXX pkg-config is a bit weird
1.10 espie 140: {
141: my $p = join(' ', @ARGV);
1.14 espie 142: $p =~ s/^\s+//;
1.66 jasper 143: @ARGV = split(/\,?\s+/, $p);
1.10 espie 144: }
1.1 ckuethe 145:
1.14 espie 146: if ($mode{myminvers}) {
147: exit self_version($mode{myminvers});
148: }
149:
150: if ($mode{list}) {
151: exit do_list();
1.1 ckuethe 152: }
153:
1.13 espie 154: my $cfg_full_list = [];
1.14 espie 155: my $top_config = [];
1.73 jasper 156:
157: # When we got here we're supposed to have had at least one
158: # package as argument.
159: if (!@ARGV){
160: say_error("No package name(s) specified.");
161: exit 1;
162: }
1.1 ckuethe 163:
164: while (@ARGV){
1.13 espie 165: my $p = shift @ARGV;
166: my $op = undef;
167: my $v = undef;
1.35 espie 168: if (@ARGV >= 2 && $ARGV[0] =~ /^[<=>]+$/ &&
1.59 jasper 169: $ARGV[1] =~ /^[\d\.]+[\w\.]*$/) {
1.13 espie 170: $op = shift @ARGV;
171: $v = shift @ARGV;
1.1 ckuethe 172: }
1.52 jasper 173: # For these modes we just need some meta-information and
174: # parsing the requirements is not needed.
175: if (!($mode{modversion} || $mode{printprovides})) {
176: handle_config($p, $op, $v, $cfg_full_list);
177: }
1.14 espie 178: push(@$top_config, $p);
179: }
180:
181: if ($mode{exists}) {
182: exit $rc;
183: }
184:
185: if ($mode{uninstalled}) {
186: $rc = 1 unless $found_uninstalled;
187: exit $rc;
1.11 espie 188: }
1.1 ckuethe 189:
1.30 jasper 190: if ($mode{modversion} || $mode{printprovides}) {
1.14 espie 191: for my $pkg (@$top_config) {
192: do_modversion($pkg);
193: }
194: }
1.13 espie 195:
1.30 jasper 196: if ($mode{printrequires} || $mode{printrequiresprivate}) {
197: for my $pkg (@$top_config) {
198: print_requires($pkg);
199: }
200: }
201:
1.14 espie 202: if ($mode{minversion}) {
203: my $v = $mode{minversion};
204: for my $pkg (@$top_config) {
205: $rc = 1 unless versionmatch($configs{$pkg}, '>=', $v);
206: }
207: exit $rc;
208: }
209:
210: if ($mode{exactversion}) {
211: my $v = $mode{exactversion};
212: for my $pkg (@$top_config) {
213: $rc = 1 unless versionmatch($configs{$pkg}, '=', $v);
214: }
215: exit $rc;
216: }
217:
1.76 jasper 218: if ($mode{maxversion}) {
1.14 espie 219: my $v = $mode{maxversion};
220: for my $pkg (@$top_config) {
221: $rc = 1 unless versionmatch($configs{$pkg}, '<=', $v);
222: }
223: exit $rc;
224: }
225:
226: my @vlist = ();
227:
228: if ($mode{variable}) {
229: for my $pkg (@$top_config) {
230: do_variable($pkg, $mode{variable});
231: }
232: }
233:
1.70 jasper 234: my $dep_cfg_list = $cfg_full_list;
235:
1.72 espie 236: if ($mode{static}){
237: $dep_cfg_list = [reverse(@$cfg_full_list)];
238: } else {
1.70 jasper 239: $dep_cfg_list = simplify_and_reverse($cfg_full_list);
240: }
1.14 espie 241:
242: if ($mode{cflags} || $mode{libs} || $mode{variable}) {
1.66 jasper 243: push @vlist, do_cflags($dep_cfg_list) if $mode{cflags};
244: push @vlist, do_libs($dep_cfg_list) if $mode{libs};
245: print join(' ', @vlist), "\n" if $rc == 0;
1.1 ckuethe 246: }
247:
1.13 espie 248: exit $rc;
1.1 ckuethe 249:
250: ###########################################################################
251:
1.11 espie 252: sub handle_config
253: {
1.13 espie 254: my ($p, $op, $v, $list) = @_;
1.35 espie 255: my $cfg = cache_find_config($p);
1.13 espie 256:
1.35 espie 257: unshift @$list, $p if defined $cfg;
1.11 espie 258:
1.35 espie 259: if (!defined $cfg) {
260: $rc = 1;
261: return undef;
262: }
1.15 espie 263:
1.35 espie 264: if (defined $op) {
265: if (!versionmatch($cfg, $op, $v)) {
266: mismatch($p, $cfg, $op, $v) if $mode{printerr};
1.13 espie 267: $rc = 1;
268: return undef;
269: }
1.35 espie 270: }
1.11 espie 271:
1.43 jasper 272: my $get_props = sub {
273: my $property = shift;
274:
275: my $deps = $cfg->get_property($property, $variables);
276: if (defined $deps) {
277: for my $dep (@$deps) {
1.46 jasper 278: if ($dep =~ m/^(.*?)\s*([<=>]+)\s*([\d\.]+|[\d\.]+[\w]*[\d]+)$/) {
1.43 jasper 279: handle_config($1, $2, $3, $list);
280: } else {
281: handle_config($dep, undef, undef, $list);
282: }
1.26 jasper 283: }
1.62 jasper 284: say_debug("package $p " . lc($property) . " " . join(',', @$deps));
1.26 jasper 285: }
1.43 jasper 286: };
287:
1.66 jasper 288: if (defined $mode{cflags}
289: or ($mode{static} && $mode{libs})
1.74 jasper 290: or $mode{printrequiresprivate}
291: or $mode{exists}) {
1.64 jasper 292: &$get_props("Requires.private");
293: }
1.43 jasper 294: &$get_props("Requires");
1.26 jasper 295:
1.11 espie 296: }
297:
1.1 ckuethe 298: # look for the .pc file in each of the PKGPATH elements. Return the path or
299: # undef if it's not there
1.4 espie 300: sub pathresolve
301: {
302: my ($p) = @_;
303:
1.14 espie 304: if ($allow_uninstalled && $p !~ m/\-uninstalled$/) {
305: foreach my $d (@PKGPATH) {
306: my $f = "$d/$p-uninstalled.pc";
1.62 jasper 307: say_debug("pathresolve($p) looking in $f");
1.14 espie 308: if (-f $f) {
309: $found_uninstalled = 1;
310: return $f;
311: }
312: }
313: }
314:
1.4 espie 315: foreach my $d (@PKGPATH) {
1.10 espie 316: my $f = "$d/$p.pc";
1.62 jasper 317: say_debug("pathresolve($p) looking in $f");
1.10 espie 318: return $f if -f $f;
1.1 ckuethe 319: }
1.10 espie 320: return undef;
1.1 ckuethe 321: }
322:
1.11 espie 323: sub get_config
324: {
325: my ($f) = @_;
326:
327: my $cfg;
1.33 jasper 328: eval {
1.11 espie 329: $cfg = OpenBSD::PkgConfig->read_file($f);
330: };
331: if (!$@) {
1.37 jasper 332: return validate_config($f, $cfg);
1.11 espie 333: } else {
1.62 jasper 334: say_debug($@);
1.11 espie 335: }
336: return undef;
337: }
338:
1.13 espie 339: sub cache_find_config
340: {
341: my $name = shift;
342:
1.62 jasper 343: say_debug("processing $name");
1.13 espie 344:
345: if (exists $configs{$name}) {
346: return $configs{$name};
347: } else {
348: return $configs{$name} = find_config($name);
349: }
1.37 jasper 350: }
351:
352: # Required elements for a valid .pc file: Name, Description, Version
353: sub validate_config
354: {
355: my ($f, $cfg) = @_;
356: my @required_elems = ('Name', 'Description', 'Version');
1.58 jasper 357:
358: # Check if we're dealing with an empty file, but don't error out just
359: # yet, we'll do that when we realize there's no Name field.
1.61 jasper 360: if (stat($f)->size == 0) {
1.58 jasper 361: my $p = $f;
362: $p =~ s/(^.*\/)(.*?)$/$2/g;
1.62 jasper 363: say_error("Package file '$p' appears to be empty");
1.58 jasper 364: }
1.37 jasper 365:
366: foreach (@required_elems) {
1.58 jasper 367: my $e = $cfg->get_property($_, $variables);
1.37 jasper 368: if (!defined $e) {
1.39 jasper 369: $f =~ s/(^.*\/)(.*?)\.pc$/$2/g;
1.62 jasper 370: say_error("Package '$f' has no $_: field");
1.37 jasper 371: return undef;
372: }
373: }
374:
375: return $cfg;
1.13 espie 376: }
377:
1.35 espie 378: # pkg-config won't install a pkg-config.pc file itself, but it may be
1.63 jasper 379: # listed as a dependency in other files. so prime the cache with self.
1.35 espie 380: sub setup_self
381: {
382: my $pkg_pc = OpenBSD::PkgConfig->new;
383: $pkg_pc->add_property('Version', $version);
1.38 jasper 384: $pkg_pc->add_variable('pc_path', join(":", @PKGPATH));
1.63 jasper 385: $pkg_pc->add_property('URL', "http://www.openbsd.org/cgi-bin/man.cgi?query=pkg-config");
386: $pkg_pc->add_property('Description', "fetch metadata about installed software packages");
1.35 espie 387: $configs{'pkg-config'} = $pkg_pc;
388: }
389:
1.11 espie 390: sub find_config
391: {
392: my ($p) = @_;
1.78 jasper 393:
394: # Differentiate between getting a full path and just the module name.
395: my $f = ($p =~ m/\.pc$/ ? $p : pathresolve($p));
1.64 jasper 396:
397: return get_config($f) if defined($f);
398:
1.62 jasper 399: say_error("Package $p was not found in the pkg-config search path");
1.61 jasper 400:
1.11 espie 401: return undef;
402: }
1.1 ckuethe 403:
1.11 espie 404: sub stringize
1.4 espie 405: {
1.11 espie 406: my $list = shift;
1.21 simon 407: my $sep = shift || ',';
1.4 espie 408:
1.11 espie 409: if (defined $list) {
1.21 simon 410: return join($sep, @$list)
1.11 espie 411: } else {
412: return '';
1.1 ckuethe 413: }
414: }
415:
416: #if the variable option is set, pull out the named variable
1.4 espie 417: sub do_variable
418: {
1.11 espie 419: my ($p, $v) = @_;
1.1 ckuethe 420:
1.13 espie 421: my $cfg = cache_find_config($p);
422:
423: if (defined $cfg) {
1.11 espie 424: my $value = $cfg->get_variable($v, $variables);
425: if (defined $value) {
1.13 espie 426: push(@vlist, $value);
1.11 espie 427: }
1.19 espie 428: return undef;
1.11 espie 429: }
1.19 espie 430: $rc = 1;
1.1 ckuethe 431: }
432:
1.30 jasper 433: #if the modversion or print-provides options are set,
434: #pull out the compiler flags
1.4 espie 435: sub do_modversion
436: {
1.11 espie 437: my ($p) = @_;
1.1 ckuethe 438:
1.13 espie 439: my $cfg = cache_find_config($p);
440:
441: if (defined $cfg) {
1.11 espie 442: my $value = $cfg->get_property('Version', $variables);
443: if (defined $value) {
1.60 jasper 444: if (defined($mode{printprovides})){
445: print "$p = " . stringize($value) . "\n";
1.30 jasper 446: return undef;
447: } else {
1.60 jasper 448: print stringize($value), "\n";
1.30 jasper 449: return undef;
450: }
1.11 espie 451: }
452: }
1.13 espie 453: $rc = 1;
1.1 ckuethe 454: }
455:
456: #if the cflags option is set, pull out the compiler flags
1.4 espie 457: sub do_cflags
458: {
1.14 espie 459: my $list = shift;
460:
1.11 espie 461: my $cflags = [];
1.1 ckuethe 462:
1.14 espie 463: foreach my $pkg (@$list) {
1.11 espie 464: my $l = $configs{$pkg}->get_property('Cflags', $variables);
465: push(@$cflags, @$l) if defined $l;
466: }
1.32 jasper 467: my $a = OpenBSD::PkgConfig->compress($cflags,
1.11 espie 468: sub {
469: local $_ = shift;
470: if (($mode{cflags} & 1) && /^-I/ ||
471: ($mode{cflags} & 2) && !/^-I/) {
472: return 1;
473: } else {
474: return 0;
1.4 espie 475: }
1.11 espie 476: });
1.32 jasper 477: if (defined($a) && defined($variables->{pc_sysrootdir})){
1.36 jasper 478: $a =~ s/[\w]?-I/$&$variables->{pc_sysrootdir}/g;
1.32 jasper 479: }
480:
481: return $a;
1.1 ckuethe 482: }
483:
484: #if the lib option is set, pull out the linker flags
1.4 espie 485: sub do_libs
486: {
1.14 espie 487: my $list = shift;
488:
1.11 espie 489: my $libs = [];
1.1 ckuethe 490:
1.68 jasper 491: # In static mode, we have to make sure we discover the libs in dependency
492: # order, not in search order. Ordering matters for static linking:
493: # Start with Libs (first our own, then dependencies), and append
494: # Libs.private (same order as for Libs).
1.14 espie 495: foreach my $pkg (@$list) {
1.11 espie 496: my $l = $configs{$pkg}->get_property('Libs', $variables);
497: push(@$libs, @$l) if defined $l;
1.67 jasper 498: if ($mode{static}) {
499: my $lp = $configs{$pkg}->get_property('Libs.private', $variables);
500: push(@$libs, @$lp) if defined $lp;
501: }
1.11 espie 502: }
1.66 jasper 503:
1.68 jasper 504: # Get the linker path directives (-L) and store it in $a.
505: # $b will be the actual libraries.
1.13 espie 506: my $a = OpenBSD::PkgConfig->compress($libs,
1.11 espie 507: sub {
508: local $_ = shift;
1.13 espie 509: if (($mode{libs} & 2) && /^-L/ ||
1.11 espie 510: ($mode{libs} & 4) && !/^-[lL]/) {
511: return 1;
512: } else {
513: return 0;
1.4 espie 514: }
1.11 espie 515: });
1.32 jasper 516:
517: if (defined($variables->{pc_sysrootdir})){
1.36 jasper 518: $a =~ s/[\w]?-[lL]/$&$variables->{pc_sysrootdir}/g;
1.32 jasper 519: }
520:
1.13 espie 521: if ($mode{libs} & 1) {
522: my $b = OpenBSD::PkgConfig->rcompress($libs,
1.66 jasper 523: sub { shift =~ m/^-l/; });
1.13 espie 524: return ($a, $b);
525: } else {
526: return $a;
527: }
1.1 ckuethe 528: }
529:
530: #list all packages
1.4 espie 531: sub do_list
532: {
1.1 ckuethe 533: my ($p, $x, $y, @files, $fname, $name);
1.20 espie 534: my $error = 0;
535:
1.33 jasper 536: foreach my $p (@PKGPATH) {
537: push(@files, <$p/*.pc>);
1.4 espie 538: }
1.1 ckuethe 539:
540: # Scan the lengths of the package names so I can make a format
541: # string to line the list up just like the real pkgconfig does.
542: $x = 0;
1.4 espie 543: foreach my $f (@files) {
544: $fname = basename($f, '.pc');
545: $y = length $fname;
1.1 ckuethe 546: $x = (($y > $x) ? $y : $x);
547: }
548: $x *= -1;
549:
1.4 espie 550: foreach my $f (@files) {
1.11 espie 551: my $cfg = get_config($f);
1.20 espie 552: if (!defined $cfg) {
1.62 jasper 553: say_warning("Problem reading file $f");
1.20 espie 554: $error = 1;
555: next;
556: }
1.4 espie 557: $fname = basename($f, '.pc');
1.33 jasper 558: printf("%${x}s %s - %s\n", $fname,
1.53 jasper 559: stringize($cfg->get_property('Name', $variables), ' '),
1.21 simon 560: stringize($cfg->get_property('Description', $variables),
561: ' '));
1.1 ckuethe 562: }
1.20 espie 563: return $error;
1.1 ckuethe 564: }
565:
1.4 espie 566: sub help
567: {
1.1 ckuethe 568: print <<EOF
569: Usage: $0 [options]
570: --debug - turn on debugging output
571: --help - this message
572: --usage - this message
573: --list-all - show all packages that $0 can find
1.8 ckuethe 574: --version - print version of pkgconfig
575: --errors-to-stdout - direct error messages to stdout rather than stderr
576: --print-errors - print error messages in case of error
1.34 jasper 577: --print-provides - print all the modules the given package provides
578: --print-requires - print all the modules the given package requires
579: --print-requires-private - print all the private modules the given package requires
1.66 jasper 580: --silence-errors - don\'t print error messages in case of error
1.1 ckuethe 581: --atleast-pkgconfig-version [version] - require a certain version of pkgconfig
582: --cflags package [versionspec] [package [versionspec]]
583: --cflags-only-I - only output -Iincludepath flags
584: --cflags-only-other - only output flags that are not -I
1.11 espie 585: --define-variable=NAME=VALUE - define variables
1.1 ckuethe 586: --libs package [versionspec] [package [versionspec]]
587: --libs-only-l - only output -llib flags
588: --libs-only-L - only output -Llibpath flags
589: --libs-only-other - only output flags that are not -l or -L
590: --exists package [versionspec] [package [versionspec]]
591: --uninstalled - allow for uninstalled versions to be used
1.8 ckuethe 592: --static - adjust output for static linking
593: --atleast-version [version] - require a certain version of a package
1.77 jasper 594: --exact-version [version] - require exactly the specified version of a package
595: --max-version [version] - require at most a certain version of a package
1.8 ckuethe 596: --modversion [package] - query the version of a package
597: --variable var package - return the definition of <var> in <package>
1.1 ckuethe 598: EOF
599: ;
1.22 simon 600: exit 0;
1.1 ckuethe 601: }
602:
603: # do we meet/beat the version the caller requested?
1.4 espie 604: sub self_version
605: {
606: my ($v) = @_;
607: my (@a, @b);
608:
1.66 jasper 609: @a = split(/\./, $v);
610: @b = split(/\./, $version);
1.1 ckuethe 611:
1.4 espie 612: if (($b[0] >= $a[0]) && ($b[1] >= $a[1])) {
1.14 espie 613: return 0;
1.1 ckuethe 614: } else {
1.14 espie 615: return 1;
616: }
617: }
618:
619: sub compare
620: {
621: my ($a, $b) = @_;
1.46 jasper 622: my ($full_a, $full_b) = ($a, $b);
623: my (@suffix_a, @suffix_b);
1.14 espie 624:
1.28 jasper 625: return 0 if ($a eq $b);
1.14 espie 626:
1.46 jasper 627: # is there a valid non-numeric suffix to deal with later?
1.58 jasper 628: # accepted are (in order): a(lpha) < b(eta) < rc < ' '.
1.46 jasper 629: # suffix[0] is the 'alpha' part, suffix[1] is the '1' part in 'alpha1'.
1.59 jasper 630: if ($a =~ s/(rc|beta|b|alpha|a)(\d+)$//) {
1.62 jasper 631: say_debug("valid suffix $1$2 found in $a$1$2.");
1.46 jasper 632: $suffix_a[0] = $1;
633: $suffix_a[1] = $2;
634: }
635:
1.59 jasper 636: if ($b =~ s/(rc|beta|b|alpha|a)(\d+)$//) {
1.62 jasper 637: say_debug("valid suffix $1$2 found in $b$1$2.");
1.46 jasper 638: $suffix_b[0] = $1;
639: $suffix_b[1] = $2;
640: }
641:
1.66 jasper 642: my @a = split(/\./, $a);
643: my @b = split(/\./, $b);
1.14 espie 644:
645: while (@a && @b) { #so long as both lists have something
1.46 jasper 646: if (!(@suffix_a || @suffix_b)) {
647: # simple comparison when no suffixes are in the game.
1.48 jasper 648: my $rc = compare_numeric($a[0], $b[0], 0);
649: return $rc if defined($rc);
1.46 jasper 650: } else {
651: # extended comparison.
1.56 jasper 652: if (((@a == 1) || (@b == 1)) &&
1.46 jasper 653: ($a[0] == $b[0])){
654: # one of the arrays has reached the last element,
655: # compare the suffix.
656:
657: # directly compare suffixes, provided both suffixes
658: # are present.
659: if (@suffix_a && @suffix_b) {
660: my $first_char = sub {
661: return substr(shift, 0, 1);
662: };
663:
664: # suffixes are equal, compare on numeric
665: if (&$first_char($suffix_a[0]) eq
666: &$first_char($suffix_b[0])) {
1.48 jasper 667: return compare_numeric($suffix_a[1], $suffix_b[1], 1);
1.46 jasper 668: }
669:
1.47 jasper 670: # rc beats beta beats alpha
1.46 jasper 671: if (&$first_char($suffix_a[0]) lt &$first_char($suffix_b[0])) {
1.62 jasper 672: say_debug("$full_a (installed) < $full_b (wanted)");
1.46 jasper 673: return -1;
674: } else {
1.62 jasper 675: say_debug("$full_a (installed) > $full_b (wanted)");
1.46 jasper 676: return 1;
677: }
678:
679: } else {
680: # one of either is lacking a suffix,
681: # thereby beating the other.
682: # e.g.: 1.02 > 1.02b1
683: if (@suffix_a) { # a is older
1.62 jasper 684: say_debug("$full_a (installed) < $full_b (wanted)");
1.55 jasper 685: return 1;
1.46 jasper 686: }
687:
688: if (@suffix_b) { # b is older
1.62 jasper 689: say_debug("$full_a (installed) > $full_b (wanted)");
1.55 jasper 690: return -1;
1.46 jasper 691: }
692: }
693: } else {
1.48 jasper 694: my $rc = compare_numeric($a[0], $b[0], 0);
695: return $rc if defined($rc);
1.46 jasper 696: }
697: }
1.14 espie 698: shift @a; shift @b;
699: }
700: return 1 if @a;
701: return -1 if @b;
702: return 0;
1.48 jasper 703: }
704:
705: # simple numeric comparison, with optional equality test.
706: sub compare_numeric
707: {
708: my ($x, $y, $eq) = @_;
709:
710: return 1 if $x > $y;
711: return -1 if $x < $y;
712: return 0 if (($x == $y) and ($eq == 1));
713: return undef;
1.1 ckuethe 714: }
715:
716: # got a package meeting the requested specific version?
1.4 espie 717: sub versionmatch
718: {
1.14 espie 719: my ($cfg, $op, $want) = @_;
1.33 jasper 720:
1.1 ckuethe 721: # can't possibly match if we can't find the file
1.11 espie 722: return 0 if !defined $cfg;
723:
1.14 espie 724: my $inst = stringize($cfg->get_property('Version', $variables));
1.11 espie 725:
1.1 ckuethe 726: # can't possibly match if we can't find the version string
1.14 espie 727: return 0 if $inst eq '';
1.1 ckuethe 728:
1.62 jasper 729: say_debug("comparing $want (wanted) to $inst (installed)");
1.14 espie 730: my $value = compare($inst, $want);
1.31 jasper 731: if ($op eq '>=') { return $value >= 0; }
732: elsif ($op eq '=') { return $value == 0; }
733: elsif ($op eq '!=') { return $value != 0; }
734: elsif ($op eq '<') { return $value < 0; }
735: elsif ($op eq '>') { return $value > 0; }
736: elsif ($op eq '<=') { return $value <= 0; }
1.13 espie 737: }
738:
739: sub mismatch
740: {
741: my ($p, $cfg, $op, $v) = @_;
1.53 jasper 742: my $name = stringize($cfg->get_property('Name'), ' ');
1.41 jasper 743: my $version = stringize($cfg->get_property('Version'));
744: my $url = stringize($cfg->get_property('URL'));
745:
1.62 jasper 746: say_warning("Requested '$p $op $v' but version of $name is $version");
747: say_warning("You may find new versions of $name at $url") if $url;
1.13 espie 748: }
749:
750: sub simplify_and_reverse
751: {
752: my $reqlist = shift;
753: my $dejavu = {};
754: my $result = [];
755:
756: for my $item (@$reqlist) {
757: if (!$dejavu->{$item}) {
758: unshift @$result, $item;
759: $dejavu->{$item} = 1;
760: }
761: }
762: return $result;
1.30 jasper 763: }
764:
765: # retrieve and print Requires(.private)
766: sub print_requires
767: {
768: my ($p) = @_;
769:
770: my $cfg = cache_find_config($p);
771:
772: if (defined($cfg)) {
773: my $value;
774:
775: if (defined($mode{printrequires})) {
776: $value = $cfg->get_property('Requires', $variables);
777: } elsif (defined($mode{printrequiresprivate})) {
778: $value = $cfg->get_property('Requires.private', $variables);
779: } else {
1.62 jasper 780: say_debug("Unknown mode for print_requires.");
1.30 jasper 781: return 1;
782: }
783:
784: if (defined($value)) {
785: print "$_\n" foreach (@$value);
786: return undef;
787: }
788: }
789:
790: $rc = 1;
1.35 espie 791: }
792:
793: sub beautify_list
794: {
795: return join(' ', map {"[$_]"} @_);
1.61 jasper 796: }
797:
1.62 jasper 798: sub say_debug
1.61 jasper 799: {
1.62 jasper 800: say_msg(shift) if $mode{debug};
1.61 jasper 801: }
802:
1.62 jasper 803: sub say_error
1.61 jasper 804: {
1.62 jasper 805: say_msg(shift) if $mode{printerr}
806: }
807:
808: sub say_warning
809: {
810: say_msg(shift);
811: }
812:
813: sub say_msg
814: {
1.63 jasper 815: my $str = shift;
1.62 jasper 816:
817: # If --errors-to-stdout was given, close STDERR (to be safe),
818: # then dup the output to STDOUT and delete the key from %mode so we
819: # won't keep checking it. STDERR stays dup'ed.
820: if ($mode{estdout}) {
821: close(STDERR);
822: open(STDERR, ">&STDOUT") or die "Can't dup STDOUT: $!";
823: delete($mode{estdout});
824: }
825:
826: print STDERR $str . "\n";
1.1 ckuethe 827: }