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