[BACK]Return to pkg-config CVS log [TXT][DIR] Up to [local] / src / usr.bin / pkg-config

Annotation of src/usr.bin/pkg-config/pkg-config, Revision 1.77

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