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