[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.50

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