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