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

Diff for /src/usr.bin/pkg-config/pkg-config between version 1.3 and 1.4

version 1.3, 2006/11/27 22:50:31 version 1.4, 2006/11/27 23:52:18
Line 18 
Line 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'};
 }  }
   
Line 39 
Line 40 
 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
Line 78 
Line 79 
                 '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;
Line 170 
Line 171 
   
   
 # 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;
                 }                  }
Line 199 
Line 202 
 }  }
   
 #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
Line 310 
Line 324 
 --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;
 }  }

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4