Annotation of src/usr.bin/pkg-config/pkg-config, Revision 1.59
1.1 ckuethe 1: #!/usr/bin/perl
1.59 ! jasper 2: # $OpenBSD: pkg-config,v 1.58 2011/06/11 12:09:06 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}) {
30: @PKGPATH = split /:/, $ENV{PKG_CONFIG_LIBDIR};
31: } elsif (defined($ENV{PKG_CONFIG_PATH}) && $ENV{PKG_CONFIG_PATH}) {
1.24 ckuethe 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.58 jasper 58: my $D;
59: defined $ENV{PKG_CONFIG_DEBUG_SPEW} ? $D = 1 : $D = 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');
76: GetOptions( 'debug' => \$D,
77: 'help' => \&help, #does not return
78: 'usage' => \&help, #does not return
1.14 espie 79: 'list-all' => \$mode{list},
1.1 ckuethe 80: 'version' => sub { print "$version\n" ; exit(0);} ,
1.11 espie 81: 'errors-to-stdout' => sub { $mode{estdout} = 1},
82: 'print-errors' => sub { $mode{printerr} = 1},
83: 'silence-errors' => sub { $mode{printerr} = 0},
1.23 jasper 84: 'short-errors' => sub { $mode{printerr} = 0},
1.14 espie 85: 'atleast-pkgconfig-version=s' => \$mode{myminvers},
1.30 jasper 86: 'print-provides' => \$mode{printprovides},
87: 'print-requires' => \$mode{printrequires},
88: 'print-requires-private' => \$mode{printrequiresprivate},
1.11 espie 89:
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},
1.14 espie 100: 'atleast-version=s' => \$mode{minversion},
101: 'exact-version=s' => \$mode{exactversion},
102: 'max-version=s' => \$mode{maxversion},
1.13 espie 103: 'modversion' => \$mode{modversion},
1.11 espie 104: 'variable=s' => \$mode{variable},
105: 'define-variable=s' => $variables,
1.1 ckuethe 106: );
107:
1.14 espie 108: # Initial value of printerr depends on the options...
109: if (!defined $mode{printerr}) {
1.33 jasper 110: if (defined $mode{libs} || defined $mode{cflags}
1.14 espie 111: || defined $mode{version} || defined $mode{list}) {
112: $mode{printerr} = 1;
113: } else {
114: $mode{printerr} = 0;
115: }
116: }
117:
1.35 espie 118: print STDERR "\n", beautify_list($0, @ARGV), "\n" if $D;
1.13 espie 119:
120: my $rc = 0;
1.1 ckuethe 121:
1.14 espie 122: # XXX pkg-config is a bit weird
1.10 espie 123: {
124: my $p = join(' ', @ARGV);
1.14 espie 125: $p =~ s/^\s+//;
1.35 espie 126: @ARGV = split /\,?\s+/, $p;
1.10 espie 127: }
1.1 ckuethe 128:
1.14 espie 129: if ($mode{myminvers}) {
130: exit self_version($mode{myminvers});
131: }
132:
133: if ($mode{list}) {
134: exit do_list();
1.1 ckuethe 135: }
136:
1.13 espie 137: my $cfg_full_list = [];
1.14 espie 138: my $top_config = [];
1.1 ckuethe 139:
140: while (@ARGV){
1.13 espie 141: my $p = shift @ARGV;
142: my $op = undef;
143: my $v = undef;
1.35 espie 144: if (@ARGV >= 2 && $ARGV[0] =~ /^[<=>]+$/ &&
1.59 ! jasper 145: $ARGV[1] =~ /^[\d\.]+[\w\.]*$/) {
1.13 espie 146: $op = shift @ARGV;
147: $v = shift @ARGV;
1.1 ckuethe 148: }
1.52 jasper 149: # For these modes we just need some meta-information and
150: # parsing the requirements is not needed.
151: if (!($mode{modversion} || $mode{printprovides})) {
152: handle_config($p, $op, $v, $cfg_full_list);
153: }
1.14 espie 154: push(@$top_config, $p);
155: }
156:
157: if ($mode{exists}) {
158: exit $rc;
159: }
160:
161: if ($mode{uninstalled}) {
162: $rc = 1 unless $found_uninstalled;
163: exit $rc;
1.11 espie 164: }
1.1 ckuethe 165:
1.30 jasper 166: if ($mode{modversion} || $mode{printprovides}) {
1.14 espie 167: for my $pkg (@$top_config) {
168: do_modversion($pkg);
169: }
170: }
1.13 espie 171:
1.30 jasper 172: if ($mode{printrequires} || $mode{printrequiresprivate}) {
173: for my $pkg (@$top_config) {
174: print_requires($pkg);
175: }
176: }
177:
1.14 espie 178: if ($mode{minversion}) {
179: my $v = $mode{minversion};
180: for my $pkg (@$top_config) {
181: $rc = 1 unless versionmatch($configs{$pkg}, '>=', $v);
182: }
183: exit $rc;
184: }
185:
186: if ($mode{exactversion}) {
187: my $v = $mode{exactversion};
188: for my $pkg (@$top_config) {
189: $rc = 1 unless versionmatch($configs{$pkg}, '=', $v);
190: }
191: exit $rc;
192: }
193:
194: if ($mode{minversion}) {
195: my $v = $mode{maxversion};
196: for my $pkg (@$top_config) {
197: $rc = 1 unless versionmatch($configs{$pkg}, '<=', $v);
198: }
199: exit $rc;
200: }
201:
202: my @vlist = ();
203:
204: if ($mode{variable}) {
205: for my $pkg (@$top_config) {
206: do_variable($pkg, $mode{variable});
207: }
208: }
209:
210: my $dep_cfg_list = simplify_and_reverse($cfg_full_list);
211:
212: if ($mode{cflags} || $mode{libs} || $mode{variable}) {
213: push @vlist, do_cflags($dep_cfg_list) if $mode{cflags};
214: push @vlist, do_libs($dep_cfg_list) if $mode{libs};
1.17 espie 215: print join(' ', @vlist), "\n" if $rc == 0;
1.1 ckuethe 216: }
217:
1.13 espie 218: exit $rc;
1.1 ckuethe 219:
220: ###########################################################################
221:
1.11 espie 222: sub handle_config
223: {
1.13 espie 224: my ($p, $op, $v, $list) = @_;
1.35 espie 225: my $cfg = cache_find_config($p);
1.13 espie 226:
1.35 espie 227: unshift @$list, $p if defined $cfg;
1.11 espie 228:
1.35 espie 229: if (!defined $cfg) {
230: $rc = 1;
231: return undef;
232: }
1.15 espie 233:
1.35 espie 234: if (defined $op) {
235: if (!versionmatch($cfg, $op, $v)) {
236: mismatch($p, $cfg, $op, $v) if $mode{printerr};
1.13 espie 237: $rc = 1;
238: return undef;
239: }
1.35 espie 240: }
1.11 espie 241:
1.43 jasper 242: my $get_props = sub {
243: my $property = shift;
244:
245: my $deps = $cfg->get_property($property, $variables);
246: if (defined $deps) {
247: for my $dep (@$deps) {
1.46 jasper 248: if ($dep =~ m/^(.*?)\s*([<=>]+)\s*([\d\.]+|[\d\.]+[\w]*[\d]+)$/) {
1.43 jasper 249: handle_config($1, $2, $3, $list);
250: } else {
251: handle_config($dep, undef, undef, $list);
252: }
1.26 jasper 253: }
1.43 jasper 254: print STDERR "package $p ", lc($property), " ",
255: join(',', @$deps), "\n" if $D;
1.26 jasper 256: }
1.43 jasper 257: };
258:
259: &$get_props("Requires");
260: &$get_props("Requires.private");
1.26 jasper 261:
1.11 espie 262: }
263:
1.1 ckuethe 264: # look for the .pc file in each of the PKGPATH elements. Return the path or
265: # undef if it's not there
1.4 espie 266: sub pathresolve
267: {
268: my ($p) = @_;
269:
1.14 espie 270: if ($allow_uninstalled && $p !~ m/\-uninstalled$/) {
271: foreach my $d (@PKGPATH) {
272: my $f = "$d/$p-uninstalled.pc";
273: print STDERR "pathresolve($p) looking in $f\n" if $D;
274: if (-f $f) {
275: $found_uninstalled = 1;
276: return $f;
277: }
278: }
279: }
280:
1.4 espie 281: foreach my $d (@PKGPATH) {
1.10 espie 282: my $f = "$d/$p.pc";
1.4 espie 283: print STDERR "pathresolve($p) looking in $f\n" if $D;
1.10 espie 284: return $f if -f $f;
1.1 ckuethe 285: }
1.10 espie 286: return undef;
1.1 ckuethe 287: }
288:
1.11 espie 289: sub get_config
290: {
291: my ($f) = @_;
292:
293: my $cfg;
1.33 jasper 294: eval {
1.11 espie 295: $cfg = OpenBSD::PkgConfig->read_file($f);
296: };
297: if (!$@) {
1.37 jasper 298: return validate_config($f, $cfg);
1.11 espie 299: } else {
1.12 espie 300: print STDERR $@, "\n" if $D;
1.11 espie 301: }
302: return undef;
303: }
304:
1.13 espie 305: sub cache_find_config
306: {
307: my $name = shift;
308:
309: print STDERR "processing $name\n" if $D;
310:
311: if (exists $configs{$name}) {
312: return $configs{$name};
313: } else {
314: return $configs{$name} = find_config($name);
315: }
1.37 jasper 316: }
317:
318: # Required elements for a valid .pc file: Name, Description, Version
319: sub validate_config
320: {
321: my ($f, $cfg) = @_;
322: my @required_elems = ('Name', 'Description', 'Version');
1.58 jasper 323:
324: # Check if we're dealing with an empty file, but don't error out just
325: # yet, we'll do that when we realize there's no Name field.
326: if ((stat($f)->size == 0) && $mode{printerr}) {
327: my $p = $f;
328: $p =~ s/(^.*\/)(.*?)$/$2/g;
329: print STDERR "Package file '$p' appears to be empty\n";
330: }
1.37 jasper 331:
332: foreach (@required_elems) {
1.58 jasper 333: my $e = $cfg->get_property($_, $variables);
1.37 jasper 334: if (!defined $e) {
1.39 jasper 335: $f =~ s/(^.*\/)(.*?)\.pc$/$2/g;
1.58 jasper 336: if ($mode{printerr}) {
337: print STDERR "Package '$f' has no $_: field\n";
338: }
1.37 jasper 339: return undef;
340: }
341: }
342:
343: return $cfg;
1.13 espie 344: }
345:
1.35 espie 346: # pkg-config won't install a pkg-config.pc file itself, but it may be
347:
348: # listed as a dependency in other files.
349: # so, prime the cache with self
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.35 espie 355: $configs{'pkg-config'} = $pkg_pc;
356: }
357:
1.11 espie 358: sub find_config
359: {
360: my ($p) = @_;
361: my $f = pathresolve($p);
362: if (defined $f) {
363: return get_config($f);
364: }
1.13 espie 365: if ($mode{printerr}) {
1.33 jasper 366: print STDERR
1.13 espie 367: "Package $p was not found in the pkg-config search path\n";
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.30 jasper 412: if (!defined($mode{printprovides})){
413: print stringize($value), "\n";
414: return undef;
415: } else {
416: print "$p = " . stringize($value) . "\n";
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.14 espie 459: foreach my $pkg (@$list) {
1.11 espie 460: my $l = $configs{$pkg}->get_property('Libs', $variables);
461: push(@$libs, @$l) if defined $l;
462: }
1.13 espie 463: my $a = OpenBSD::PkgConfig->compress($libs,
1.11 espie 464: sub {
465: local $_ = shift;
1.13 espie 466: if (($mode{libs} & 2) && /^-L/ ||
1.11 espie 467: ($mode{libs} & 4) && !/^-[lL]/) {
468: return 1;
469: } else {
470: return 0;
1.4 espie 471: }
1.11 espie 472: });
1.32 jasper 473:
474: if (defined($variables->{pc_sysrootdir})){
1.36 jasper 475: $a =~ s/[\w]?-[lL]/$&$variables->{pc_sysrootdir}/g;
1.32 jasper 476: }
477:
1.13 espie 478: if ($mode{libs} & 1) {
479: my $b = OpenBSD::PkgConfig->rcompress($libs,
480: sub { shift =~ m/^-l/; });
481: return ($a, $b);
482: } else {
483: return $a;
484: }
1.1 ckuethe 485: }
486:
487: #list all packages
1.4 espie 488: sub do_list
489: {
1.1 ckuethe 490: my ($p, $x, $y, @files, $fname, $name);
1.20 espie 491: my $error = 0;
492:
1.33 jasper 493: foreach my $p (@PKGPATH) {
494: push(@files, <$p/*.pc>);
1.4 espie 495: }
1.1 ckuethe 496:
497: # Scan the lengths of the package names so I can make a format
498: # string to line the list up just like the real pkgconfig does.
499: $x = 0;
1.4 espie 500: foreach my $f (@files) {
501: $fname = basename($f, '.pc');
502: $y = length $fname;
1.1 ckuethe 503: $x = (($y > $x) ? $y : $x);
504: }
505: $x *= -1;
506:
1.4 espie 507: foreach my $f (@files) {
1.11 espie 508: my $cfg = get_config($f);
1.20 espie 509: if (!defined $cfg) {
510: print STDERR "Problem reading file $f\n";
511: $error = 1;
512: next;
513: }
1.4 espie 514: $fname = basename($f, '.pc');
1.33 jasper 515: printf("%${x}s %s - %s\n", $fname,
1.53 jasper 516: stringize($cfg->get_property('Name', $variables), ' '),
1.21 simon 517: stringize($cfg->get_property('Description', $variables),
518: ' '));
1.1 ckuethe 519: }
1.20 espie 520: return $error;
1.1 ckuethe 521: }
522:
1.4 espie 523: sub help
524: {
1.1 ckuethe 525: print <<EOF
526: Usage: $0 [options]
527: --debug - turn on debugging output
528: --help - this message
529: --usage - this message
530: --list-all - show all packages that $0 can find
1.8 ckuethe 531: --version - print version of pkgconfig
532: --errors-to-stdout - direct error messages to stdout rather than stderr
533: --print-errors - print error messages in case of error
1.34 jasper 534: --print-provides - print all the modules the given package provides
535: --print-requires - print all the modules the given package requires
536: --print-requires-private - print all the private modules the given package requires
1.8 ckuethe 537: --silence-errors - don't print error messages in case of error
1.1 ckuethe 538: --atleast-pkgconfig-version [version] - require a certain version of pkgconfig
539: --cflags package [versionspec] [package [versionspec]]
540: --cflags-only-I - only output -Iincludepath flags
541: --cflags-only-other - only output flags that are not -I
1.11 espie 542: --define-variable=NAME=VALUE - define variables
1.1 ckuethe 543: --libs package [versionspec] [package [versionspec]]
544: --libs-only-l - only output -llib flags
545: --libs-only-L - only output -Llibpath flags
546: --libs-only-other - only output flags that are not -l or -L
547: --exists package [versionspec] [package [versionspec]]
548: --uninstalled - allow for uninstalled versions to be used
1.8 ckuethe 549: --static - adjust output for static linking
550: --atleast-version [version] - require a certain version of a package
551: --modversion [package] - query the version of a package
552: --variable var package - return the definition of <var> in <package>
1.1 ckuethe 553: EOF
554: ;
1.22 simon 555: exit 0;
1.1 ckuethe 556: }
557:
558: # do we meet/beat the version the caller requested?
1.4 espie 559: sub self_version
560: {
561: my ($v) = @_;
562: my (@a, @b);
563:
564: @a = split /\./, $v;
565: @b = split /\./, $version;
1.1 ckuethe 566:
1.4 espie 567: if (($b[0] >= $a[0]) && ($b[1] >= $a[1])) {
1.14 espie 568: return 0;
1.1 ckuethe 569: } else {
1.14 espie 570: return 1;
571: }
572: }
573:
574: sub compare
575: {
576: my ($a, $b) = @_;
1.46 jasper 577: my ($full_a, $full_b) = ($a, $b);
578: my (@suffix_a, @suffix_b);
1.14 espie 579:
1.28 jasper 580: return 0 if ($a eq $b);
1.14 espie 581:
1.46 jasper 582: # is there a valid non-numeric suffix to deal with later?
1.58 jasper 583: # accepted are (in order): a(lpha) < b(eta) < rc < ' '.
1.46 jasper 584: # suffix[0] is the 'alpha' part, suffix[1] is the '1' part in 'alpha1'.
1.58 jasper 585: # XXX: add back 'rc'
1.59 ! jasper 586: if ($a =~ s/(rc|beta|b|alpha|a)(\d+)$//) {
1.57 jasper 587: print STDERR "valid suffix $1$2 found in $a$1$2.\n" if $D;
1.46 jasper 588: $suffix_a[0] = $1;
589: $suffix_a[1] = $2;
590: }
591:
1.59 ! jasper 592: if ($b =~ s/(rc|beta|b|alpha|a)(\d+)$//) {
1.57 jasper 593: print STDERR "valid suffix $1$2 found in $b$1$2.\n" if $D;
1.46 jasper 594: $suffix_b[0] = $1;
595: $suffix_b[1] = $2;
596: }
597:
1.14 espie 598: my @a = split /\./, $a;
599: my @b = split /\./, $b;
600:
601: while (@a && @b) { #so long as both lists have something
1.46 jasper 602: if (!(@suffix_a || @suffix_b)) {
603: # simple comparison when no suffixes are in the game.
1.48 jasper 604: my $rc = compare_numeric($a[0], $b[0], 0);
605: return $rc if defined($rc);
1.46 jasper 606: } else {
607: # extended comparison.
1.56 jasper 608: if (((@a == 1) || (@b == 1)) &&
1.46 jasper 609: ($a[0] == $b[0])){
610: # one of the arrays has reached the last element,
611: # compare the suffix.
612:
613: # directly compare suffixes, provided both suffixes
614: # are present.
615: if (@suffix_a && @suffix_b) {
616: my $first_char = sub {
617: return substr(shift, 0, 1);
618: };
619:
620: # suffixes are equal, compare on numeric
621: if (&$first_char($suffix_a[0]) eq
622: &$first_char($suffix_b[0])) {
1.48 jasper 623: return compare_numeric($suffix_a[1], $suffix_b[1], 1);
1.46 jasper 624: }
625:
1.47 jasper 626: # rc beats beta beats alpha
1.46 jasper 627: if (&$first_char($suffix_a[0]) lt &$first_char($suffix_b[0])) {
628: print STDERR "$full_a (installed) < $full_b (wanted)\n" if $D;
629: return -1;
630: } else {
631: print STDERR "$full_a (installed) > $full_b (wanted)\n" if $D;
632: return 1;
633: }
634:
635: } else {
636: # one of either is lacking a suffix,
637: # thereby beating the other.
638: # e.g.: 1.02 > 1.02b1
639: if (@suffix_a) { # a is older
640: print STDERR "$full_a (installed) < $full_b (wanted)\n" if $D;
1.55 jasper 641: return 1;
1.46 jasper 642: }
643:
644: if (@suffix_b) { # b is older
645: print STDERR "$full_a (installed) > $full_b (wanted)\n" if $D;
1.55 jasper 646: return -1;
1.46 jasper 647: }
648: }
649: } else {
1.48 jasper 650: my $rc = compare_numeric($a[0], $b[0], 0);
651: return $rc if defined($rc);
1.46 jasper 652: }
653: }
1.14 espie 654: shift @a; shift @b;
655: }
656: return 1 if @a;
657: return -1 if @b;
658: return 0;
1.48 jasper 659: }
660:
661: # simple numeric comparison, with optional equality test.
662: sub compare_numeric
663: {
664: my ($x, $y, $eq) = @_;
665:
666: return 1 if $x > $y;
667: return -1 if $x < $y;
668: return 0 if (($x == $y) and ($eq == 1));
669: return undef;
1.1 ckuethe 670: }
671:
672: # got a package meeting the requested specific version?
1.4 espie 673: sub versionmatch
674: {
1.14 espie 675: my ($cfg, $op, $want) = @_;
1.33 jasper 676:
1.1 ckuethe 677: # can't possibly match if we can't find the file
1.11 espie 678: return 0 if !defined $cfg;
679:
1.14 espie 680: my $inst = stringize($cfg->get_property('Version', $variables));
1.11 espie 681:
1.1 ckuethe 682: # can't possibly match if we can't find the version string
1.14 espie 683: return 0 if $inst eq '';
1.1 ckuethe 684:
1.14 espie 685: print "comparing $want (wanted) to $inst (installed)\n" if $D;
686: my $value = compare($inst, $want);
1.31 jasper 687: if ($op eq '>=') { return $value >= 0; }
688: elsif ($op eq '=') { return $value == 0; }
689: elsif ($op eq '!=') { return $value != 0; }
690: elsif ($op eq '<') { return $value < 0; }
691: elsif ($op eq '>') { return $value > 0; }
692: elsif ($op eq '<=') { return $value <= 0; }
1.13 espie 693: }
694:
695: sub mismatch
696: {
697: my ($p, $cfg, $op, $v) = @_;
1.53 jasper 698: my $name = stringize($cfg->get_property('Name'), ' ');
1.41 jasper 699: my $version = stringize($cfg->get_property('Version'));
700: my $url = stringize($cfg->get_property('URL'));
701:
702: print STDERR "Requested '$p $op $v' but version of $name is $version\n";
703: print STDERR "You may find new versions of $name at $url\n" if $url;
1.13 espie 704: }
705:
706: sub simplify_and_reverse
707: {
708: my $reqlist = shift;
709: my $dejavu = {};
710: my $result = [];
711:
712: for my $item (@$reqlist) {
713: if (!$dejavu->{$item}) {
714: unshift @$result, $item;
715: $dejavu->{$item} = 1;
716: }
717: }
718: return $result;
1.30 jasper 719: }
720:
721: # retrieve and print Requires(.private)
722: sub print_requires
723: {
724: my ($p) = @_;
725:
726: my $cfg = cache_find_config($p);
727:
728: if (defined($cfg)) {
729: my $value;
730:
731: if (defined($mode{printrequires})) {
732: $value = $cfg->get_property('Requires', $variables);
733: } elsif (defined($mode{printrequiresprivate})) {
734: $value = $cfg->get_property('Requires.private', $variables);
735: } else {
736: print STDERR "Unknown mode for print_requires.\n" if $D;
737: return 1;
738: }
739:
740: if (defined($value)) {
741: print "$_\n" foreach (@$value);
742: return undef;
743: }
744: }
745:
746: $rc = 1;
1.35 espie 747: }
748:
749: sub beautify_list
750: {
751: return join(' ', map {"[$_]"} @_);
1.1 ckuethe 752: }