version 1.3, 2006/11/27 22:50:31 |
version 1.4, 2006/11/27 23:52:18 |
|
|
use strict; |
use strict; |
use warnings; |
use warnings; |
use Getopt::Long; |
use Getopt::Long; |
|
use File::Basename; |
|
|
my @PKGPATH = qw(/usr/local/lib/pkgconfig /usr/X11R6/lib/pkgconfig ); |
my @PKGPATH = qw(/usr/local/lib/pkgconfig /usr/X11R6/lib/pkgconfig ); |
|
|
if (defined($ENV{'PKG_CONFIG_PATH'}) && $ENV{'PKG_CONFIG_PATH'}){ |
if (defined($ENV{'PKG_CONFIG_PATH'}) && $ENV{'PKG_CONFIG_PATH'}) { |
push(@PKGPATH, split(/:/,$ENV{'PKG_CONFIG_PATH'})); |
push(@PKGPATH, split /:/, $ENV{'PKG_CONFIG_PATH'}); |
} |
} |
|
|
my $logfile = ''; |
my $logfile = ''; |
if (defined($ENV{'PKG_CONFIG_LOGFILE'}) && $ENV{'PKG_CONFIG_LOGFILE'}){ |
if (defined($ENV{'PKG_CONFIG_LOGFILE'}) && $ENV{'PKG_CONFIG_LOGFILE'}) { |
$logfile = $ENV{'PKG_CONFIG_LOGFILE'}; |
$logfile = $ENV{'PKG_CONFIG_LOGFILE'}; |
} |
} |
|
|
|
|
our $D = 0; # debug flag |
our $D = 0; # debug flag |
|
|
$/ = undef; |
$/ = undef; |
if ($logfile){ |
if ($logfile) { |
open (L, ">>" . $logfile); |
open my $L, ">>" . $logfile; |
print L '[' . join('] [', $0, @ARGV) . "]\n"; |
print $L '[' . join('] [', $0, @ARGV) . "]\n"; |
close(L); |
close $L; |
} |
} |
|
|
# combo arg-parsing and dependency resolution loop. Hopefully when the loop |
# combo arg-parsing and dependency resolution loop. Hopefully when the loop |
|
|
'variable=s' => \$mode{'variable'} |
'variable=s' => \$mode{'variable'} |
); |
); |
|
|
print STDERR "\n[" . join('] [', $0, @ARGV) . "]\n" if ($D); |
print STDERR "\n[" . join('] [', $0, @ARGV) . "]\n" if $D; |
self_version($mode{'minvers'}) if ($mode{'minvers'}); #does not return |
self_version($mode{'minvers'}) if $mode{'minvers'}; #does not return |
do_modversion($mode{'modversion'}) if ($mode{'modversion'}); #does not return |
do_modversion($mode{'modversion'}) if $mode{'modversion'}; #does not return |
|
|
$p = join(' ', @ARGV); |
$p = join(' ', @ARGV); |
$p =~ s/\s+/ /g; |
$p =~ s/\s+/ /g; |
$p =~ s/^\s//g; |
$p =~ s/^\s//g; |
@ARGV = split(/\s+/, $p); |
@ARGV = split /\s+/, $p; |
|
|
if (defined($mode{'exists'})){ |
if (defined $mode{'exists'}) { |
while (@ARGV){ |
while (@ARGV) { |
if ((@ARGV >= 2) && ($ARGV[1] =~ /[<=>]+/) && |
if ((@ARGV >= 2) && ($ARGV[1] =~ /[<=>]+/) && |
($ARGV[2] =~ /[0-9\.]+/)){ |
($ARGV[2] =~ /[0-9\.]+/)) { |
exit 1 unless (versionmatch(@ARGV)); |
exit 1 unless versionmatch(@ARGV); |
shift(@ARGV); shift(@ARGV); shift(@ARGV); |
shift @ARGV; shift @ARGV; shift @ARGV; |
} else { |
} else { |
exit 1 unless (pathresolve($ARGV[0])); |
exit 1 unless pathresolve($ARGV[0]); |
shift(@ARGV); |
shift @ARGV; |
} |
} |
} |
} |
exit(0); |
exit 0; |
} |
} |
|
|
do_variable($ARGV[0],$mode{'variable'}) if ($mode{'variable'}); |
do_variable($ARGV[0], $mode{'variable'}) if $mode{'variable'}; |
|
|
while (@ARGV){ |
while (@ARGV){ |
$p = $ARGV[0]; |
$p = $ARGV[0]; |
if ((@ARGV >= 2) && ($ARGV[1] =~ /[<=>]+/) && |
if ((@ARGV >= 2) && ($ARGV[1] =~ /[<=>]+/) && |
($ARGV[2] =~ /[0-9\.]+/)){ |
($ARGV[2] =~ /[0-9\.]+/)) { |
shift(@ARGV); |
shift @ARGV; |
shift(@ARGV); |
shift @ARGV; |
} |
} |
shift(@ARGV); |
shift @ARGV; |
$p =~ s/,//g; |
$p =~ s/,//g; |
unless ($configs{$p}){ # don't reprocess things we've seen |
unless ($configs{$p}) { # don't reprocess things we've seen |
print STDERR "processing $p\n" if ($D); |
print STDERR "processing $p\n" if $D; |
if ($f = pathresolve($p)){ # locate the .pc file |
if ($f = pathresolve($p)) { # locate the .pc file |
exit(0) if (defined($mode{'exists'})); |
exit 0 if defined $mode{'exists'}; |
|
|
$configs{$p} = slurp($f); # load the config |
$configs{$p} = slurp($f); # load the config |
$deps = ''; |
$deps = ''; |
if ($configs{$p} =~ /\bRequires: +(\w.+?)\n/){ |
if ($configs{$p} =~ /\bRequires: +(\w.+?)\n/) { |
$deps = $1; |
$deps = $1; |
# XXX how should i handle versions? |
# XXX how should i handle versions? |
$deps =~ s/[<>=]+\s*[0-9\.]+\s*//; |
$deps =~ s/[<>=]+\s*[0-9\.]+\s*//; |
$deps =~ tr/,/ /; |
$deps =~ tr/,/ /; |
} |
} |
print STDERR "package $p requires '$deps'\n" |
print STDERR "package $p requires '$deps'\n" |
if ($D && $deps); |
if $D && $deps; |
push(@ARGV, split(/\s+/,$deps)) if ($deps); |
push(@ARGV, split /\s+/, $deps) if $deps; |
|
|
$privdeps = ''; |
$privdeps = ''; |
if ($configs{$p} =~ /\bRequires\.private: +(\w.+?)\n/){ |
if ($configs{$p} =~ /\bRequires\.private: +(\w.+?)\n/) { |
$privdeps = $1; |
$privdeps = $1; |
# XXX how should i handle versions? |
# XXX how should i handle versions? |
$privdeps =~ s/[<>=]+\s*[0-9\.]+\s*//; |
$privdeps =~ s/[<>=]+\s*[0-9\.]+\s*//; |
} |
} |
print STDERR "package $p requires (private) '" . |
print STDERR "package $p requires (private) '" . |
$privdeps . "'\n" if ($D && $privdeps); |
$privdeps . "'\n" if $D && $privdeps; |
push(@ARGV, split(/\s+/,$privdeps)) if ($privdeps); |
push(@ARGV, split /\s+/, $privdeps) if $privdeps; |
|
|
} else { |
} else { |
warn("can't find $p\n"); |
warn "can't find $p\n"; |
exit(1); |
exit 1; |
} |
} |
} |
} |
} |
} |
|
|
do_cflags() if ($mode{'cflags'}); |
do_cflags() if $mode{'cflags'}; |
do_libs() if ($mode{'libs'}); |
do_libs() if $mode{'libs'}; |
|
|
exit(0); |
exit 0; |
|
|
########################################################################### |
########################################################################### |
|
|
# look for the .pc file in each of the PKGPATH elements. Return the path or |
# look for the .pc file in each of the PKGPATH elements. Return the path or |
# undef if it's not there |
# undef if it's not there |
sub pathresolve{ |
sub pathresolve |
my ($p); |
{ |
|
my ($p) = @_; |
|
|
$p = shift; |
foreach my $d (@PKGPATH) { |
foreach (@PKGPATH){ |
$f = "$d/$p.pc"; |
$f = $_ . '/' . ${p} . '.pc'; |
print STDERR "pathresolve($p) looking in $f\n" if $D; |
print STDERR "pathresolve($p) looking in $f\n" if ($D); |
last if -f $f; |
last if (-f $f); |
|
$f = undef; |
$f = undef; |
} |
} |
return $f; |
return $f; |
|
|
|
|
|
|
# Given a filename, return its contents. Also do variable substitutions. |
# Given a filename, return its contents. Also do variable substitutions. |
sub slurp{ |
sub slurp |
my ($f); |
{ |
|
my ($f) = @_; |
|
|
$f = shift; |
open my $F, '<', $f or return undef; |
open(F, $f) or return undef; |
print STDERR "slurp($f) OK\n" if $D; |
print STDERR "slurp($f) OK\n" if ($D); |
$f = <$F>; |
$f = <F>; |
close $F; |
close(F); |
|
$f = varsub($f); |
$f = varsub($f); |
return $f; |
return $f; |
} |
} |
|
|
# Do variable substitutions, so if "target=x11" is present (for example), |
# Do variable substitutions, so if "target=x11" is present (for example), |
# any lines referring to $target are filled in properly. |
# any lines referring to $target are filled in properly. |
sub varsub{ |
sub varsub |
|
{ |
|
my ($buf) = @_; |
|
|
my ($var, $val); |
my ($var, $val); |
|
|
my $buf = shift; |
while ($buf =~ /\${(\w+)}/gsm) { |
while ($buf =~ /\${(\w+)}/gsm){ |
|
$var = $1; |
$var = $1; |
if ($buf =~ /${var}=(.+?)\n/s){ |
if ($buf =~ /${var}=(.+?)\n/s) { |
$val = $1; |
$val = $1; |
$buf =~ s/\${$var}/$val/g; |
$buf =~ s/\${$var}/$val/g; |
} |
} |
|
|
} |
} |
|
|
#if the variable option is set, pull out the named variable |
#if the variable option is set, pull out the named variable |
sub do_variable{ |
sub do_variable |
|
{ |
my ($p, $v, undef) = @_; |
my ($p, $v, undef) = @_; |
my ($f); |
my ($f); |
|
|
exit(1) unless ($f = pathresolve($p)); |
exit 1 unless $f = pathresolve($p); |
exit(1) unless ($f = slurp($f)); |
exit 1 unless $f = slurp($f); |
|
|
exit(1) unless ($f =~ /\b${v}=(.+?)\n/); |
exit 1 unless $f =~ /\b${v}=(.+?)\n/; |
print "$1\n"; |
print "$1\n"; |
exit(0); |
exit 0; |
} |
} |
|
|
#if the modversion option is set, pull out the compiler flags |
#if the modversion option is set, pull out the compiler flags |
sub do_modversion{ |
sub do_modversion |
|
{ |
my ($p, undef) = @_; |
my ($p, undef) = @_; |
my ($f); |
my ($f); |
|
|
exit(1) unless ($f = pathresolve($p)); |
exit 1 unless $f = pathresolve($p); |
exit(1) unless ($f = slurp($f)); |
exit 1 unless $f = slurp($f); |
|
|
exit(1) unless ($f =~ /\bVersion:\s+(.+?)\n/); |
exit 1 unless $f =~ /\bVersion:\s+(.+?)\n/; |
print "$1\n"; |
print "$1\n"; |
exit(0); |
exit 0; |
} |
} |
|
|
#if the cflags option is set, pull out the compiler flags |
#if the cflags option is set, pull out the compiler flags |
sub do_cflags{ |
sub do_cflags |
|
{ |
my %words; # store them as a hash to get de-duplicating |
my %words; # store them as a hash to get de-duplicating |
my @out; |
my @out; |
|
|
foreach my $p (keys %configs){ |
foreach my $p (keys %configs) { |
if ($configs{$p} =~ /\bCflags:\s+(.+?)\n/){ |
if ($configs{$p} =~ /\bCflags:\s+(.+?)\n/) { |
foreach (split(/\s+/, $1)){ $words{$_}=1; } |
foreach my $q (split /\s+/, $1) { |
|
$words{$q}=1; |
|
} |
} |
} |
} |
} |
foreach (sort keys %words){ |
foreach my $k (sort keys %words) { |
push(@out, $_) if (/^-I/ && ($mode{'cflags'} & 1)); |
push(@out, $k) if $k =~ /^-I/ && ($mode{'cflags'} & 1); |
push(@out, $_) if (/^-[^I]/ && ($mode{'cflags'} & 2)); |
push(@out, $k) if $k =~ /^-[^I]/ && ($mode{'cflags'} & 2); |
} |
} |
printf("%s\n", join(' ', @out)); |
print join(' ', @out), "\n"; |
|
return undef; |
} |
} |
|
|
#if the lib option is set, pull out the linker flags |
#if the lib option is set, pull out the linker flags |
sub do_libs{ |
sub do_libs |
|
{ |
my %words; # store them as a hash to get de-duplicating |
my %words; # store them as a hash to get de-duplicating |
my @out; |
my @out; |
|
|
foreach my $p (keys %configs){ |
foreach my $p (keys %configs) { |
if ($configs{$p} =~ /\bLibs:\s+(.+?)\n/){ |
if ($configs{$p} =~ /\bLibs:\s+(.+?)\n/) { |
foreach (split(/\s+/, $1)){ $words{$_}=1; } |
foreach my $q (split /\s+/, $1) { |
|
$words{$q}=1; |
|
} |
} |
} |
} |
} |
foreach (sort keys %words){ |
foreach my $k (sort keys %words) { |
push(@out, $_) if (/^-l/ && ($mode{'libs'} & 1)); |
push(@out, $k) if $k =~ /^-l/ && ($mode{'libs'} & 1); |
push(@out, $_) if (/^-L/ && ($mode{'libs'} & 2)); |
push(@out, $k) if $k =~ /^-L/ && ($mode{'libs'} & 2); |
push(@out, $_) if (/^-[^lL]/ && ($mode{'libs'} & 4)); |
push(@out, $k) if $k =~ /^-[^lL]/ && ($mode{'libs'} & 4); |
} |
} |
printf("%s\n", join(' ', @out)); |
print join(' ', @out), "\n"; |
|
return undef; |
} |
} |
|
|
#list all packages |
#list all packages |
sub do_list{ |
sub do_list |
|
{ |
my ($p, $x, $y, @files, $fname, $name); |
my ($p, $x, $y, @files, $fname, $name); |
foreach (@PKGPATH){ push(@files, <$_/*.pc>); } |
foreach my $p (@PKGPATH) { |
|
push(@files, <$p/*.pc>); |
|
} |
|
|
# Scan the lengths of the package names so I can make a format |
# Scan the lengths of the package names so I can make a format |
# string to line the list up just like the real pkgconfig does. |
# string to line the list up just like the real pkgconfig does. |
$x = 0; |
$x = 0; |
foreach (@files){ |
foreach my $f (@files) { |
$fname = (split(/\//, $_))[-1]; |
$fname = basename($f, '.pc'); |
$fname =~ s/\.pc$//; |
$y = length $fname; |
$y = length($fname); |
|
$x = (($y > $x) ? $y : $x); |
$x = (($y > $x) ? $y : $x); |
} |
} |
$x *= -1; |
$x *= -1; |
|
|
foreach (@files){ |
foreach my $f (@files) { |
$p = slurp($_); |
$p = slurp($f); |
$fname = (split(/\//, $_))[-1]; |
$fname = basename($f, '.pc'); |
$fname =~ s/\.pc$//; |
if ($p =~ /Name: (\w[^\n]+)\n/gm) { |
if ($p =~ /Name: (\w[^\n]+)\n/gm){ |
|
$name = $1; |
$name = $1; |
if ($p =~ /Description:\s+(\w[^\n]+)\n/gm){ |
if ($p =~ /Description:\s+(\w[^\n]+)\n/gm) { |
printf("%${x}s %s - %s\n", $fname, $name, $1); |
printf("%${x}s %s - %s\n", $fname, $name, $1); |
} |
} |
} |
} |
} |
} |
exit(0); |
exit 0; |
} |
} |
|
|
sub help{ |
sub help |
my ($unused); |
{ |
print <<EOF |
print <<EOF |
Usage: $0 [options] |
Usage: $0 [options] |
--debug - turn on debugging output |
--debug - turn on debugging output |
|
|
--uninstalled - allow for uninstalled versions to be used |
--uninstalled - allow for uninstalled versions to be used |
EOF |
EOF |
; |
; |
exit(1); |
exit 1; |
} |
} |
|
|
# do we meet/beat the version the caller requested? |
# do we meet/beat the version the caller requested? |
sub self_version{ |
sub self_version |
my (@a, @b, $v); |
{ |
$v = shift; |
my ($v) = @_; |
@a = split(/\./, $v); |
my (@a, @b); |
@b = split(/\./, $version); |
|
|
|
if (($b[0] >= $a[0]) && ($b[1] >= $a[1])){ |
@a = split /\./, $v; |
exit(0); |
@b = split /\./, $version; |
|
|
|
if (($b[0] >= $a[0]) && ($b[1] >= $a[1])) { |
|
exit 0; |
} else { |
} else { |
exit(1); |
exit 1; |
} |
} |
} |
} |
|
|
# got a package meeting the requested specific version? |
# got a package meeting the requested specific version? |
sub versionmatch{ |
sub versionmatch |
|
{ |
my ($pname, $op, $ver, undef) = @_; |
my ($pname, $op, $ver, undef) = @_; |
my (@want, @inst, $m, $f); |
my (@want, @inst, $m, $f); |
|
|
print STDERR "pname = '$pname'\n" if ($D); |
print STDERR "pname = '$pname'\n" if $D; |
# can't possibly match if we can't find the file |
# can't possibly match if we can't find the file |
return 0 unless ($f = pathresolve($pname)); |
return 0 unless $f = pathresolve($pname); |
# load the file |
# load the file |
$configs{$pname} = slurp($f); |
$configs{$pname} = slurp($f); |
# can't possibly match if we can't find the version string |
# can't possibly match if we can't find the version string |
return 0 unless ($configs{$pname} =~ /Version: ([0-9\.]+)\n/gm); |
return 0 unless $configs{$pname} =~ /Version: ([0-9\.]+)\n/gm; |
|
|
print "comparing $ver (wanted) to $1 (installed)\n" if ($D); |
print "comparing $ver (wanted) to $1 (installed)\n" if $D; |
@inst = split(/\./, $1); |
@inst = split /\./, $1; |
@want = split(/\./, $ver); |
@want = split /\./, $ver; |
|
|
while (@inst && @want){ #so long as both lists have something |
while (@inst && @want) { #so long as both lists have something |
# bail if the requested version element beats existing |
# bail if the requested version element beats existing |
return 1 if ($inst[0] > $want[0]); |
return 1 if $inst[0] > $want[0]; |
return 0 if ($inst[0] < $want[0]); |
return 0 if $inst[0] < $want[0]; |
shift(@inst); shift(@want); |
shift @inst; shift @want; |
} |
} |
# the version at least equals the requested. if the requested |
# the version at least equals the requested. if the requested |
# version has some micropatchlevel beyond the existing version, |
# version has some micropatchlevel beyond the existing version, |
# return failure |
# return failure |
return 0 if (@want); |
return 0 if @want; |
# and after all that, the version is good enough |
# and after all that, the version is good enough |
return 1; |
return 1; |
} |
} |